r26136 - in /branches/upstream/libtext-csv-xs-perl/current: CSV_XS.pm CSV_XS.xs ChangeLog META.yml Makefile.PL t/20_file.t t/21_lexicalio.t t/22_scalario.t t/65_allow.t t/70_rt.t
ansgar-guest at users.alioth.debian.org
ansgar-guest at users.alioth.debian.org
Sat Oct 18 11:40:05 UTC 2008
Author: ansgar-guest
Date: Sat Oct 18 11:40:00 2008
New Revision: 26136
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=26136
Log:
[svn-upgrade] Integrating new upstream version, libtext-csv-xs-perl (0.55)
Modified:
branches/upstream/libtext-csv-xs-perl/current/CSV_XS.pm
branches/upstream/libtext-csv-xs-perl/current/CSV_XS.xs
branches/upstream/libtext-csv-xs-perl/current/ChangeLog
branches/upstream/libtext-csv-xs-perl/current/META.yml
branches/upstream/libtext-csv-xs-perl/current/Makefile.PL
branches/upstream/libtext-csv-xs-perl/current/t/20_file.t
branches/upstream/libtext-csv-xs-perl/current/t/21_lexicalio.t
branches/upstream/libtext-csv-xs-perl/current/t/22_scalario.t
branches/upstream/libtext-csv-xs-perl/current/t/65_allow.t
branches/upstream/libtext-csv-xs-perl/current/t/70_rt.t
Modified: branches/upstream/libtext-csv-xs-perl/current/CSV_XS.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-csv-xs-perl/current/CSV_XS.pm?rev=26136&op=diff
==============================================================================
--- branches/upstream/libtext-csv-xs-perl/current/CSV_XS.pm (original)
+++ branches/upstream/libtext-csv-xs-perl/current/CSV_XS.pm Sat Oct 18 11:40:00 2008
@@ -16,7 +16,7 @@
# Based on Text::CSV by:
# Alan Citterman <alan at mfgrtl.com>
#
-# Extended by:
+# Extended and Remodelled by:
# H.Merijn Brand (h.m.brand at xs4all.nl)
#
############################################################################
@@ -30,8 +30,9 @@
use Carp;
use vars qw( $VERSION @ISA );
-$VERSION = "0.54";
+$VERSION = "0.55";
@ISA = qw( DynaLoader );
+bootstrap Text::CSV_XS $VERSION;
sub PV { 0 }
sub IV { 1 }
@@ -77,7 +78,7 @@
_COLUMN_NAMES => undef,
_BOUND_COLUMNS => undef,
);
-my $last_new_err = "";
+my $last_new_err = Text::CSV_XS->SetDiag (0);
sub new
{
@@ -92,9 +93,9 @@
$last_new_err = "Unknown attribute '$_'";
return;
}
- $last_new_err = "";
+ $last_new_err = SetDiag (undef, 0);
my $self = {%def_attr, %{$attr}};
- defined $\ and $self->{eol} = $\;
+ defined $\ && !exists $attr->{eol} and $self->{eol} = $\;
bless $self, $class;
defined $self->{types} and $self->types ($self->{types});
$self;
@@ -666,8 +667,8 @@
=item eol
An end-of-line string to add to rows, usually C<undef> (nothing,
-default), C<"\012"> (Line Feed) or C<"\015\012"> (Carriage Return,
-Line Feed). Cannot be longer than 7 (ASCII) characters.
+default = C<$\>), C<"\012"> (Line Feed) or C<"\015\012"> (Carriage
+Return, Line Feed). Cannot be longer than 7 (ASCII) characters.
If both C<$/> and C<eol> equal C<"\015">, parsing lines that end on
only a Carriage Return without Line Feed, will be C<parse>d correct.
@@ -682,6 +683,8 @@
The separation character can not be equal to the quote character.
The separation character can not be equal to the escape character.
+
+See also CAVEATS
=item allow_whitespace
@@ -868,7 +871,7 @@
quote_char => '"',
escape_char => '"',
sep_char => ',',
- eol => '',
+ eol => $\,
always_quote => 0,
binary => 0,
keep_meta_info => 0,
@@ -1221,7 +1224,7 @@
}
close $csv_fh or die "hello.csv: $!";
-Or using the C<print ()> method, which is fater like in
+Or using the C<print ()> method, which is faster like in
dumping the content of a database ($dbh) table ($tbl) to CSV:
my $csv = Text::CSV_XS->new ({ binary => 1, eol => $/ });
@@ -1241,13 +1244,31 @@
while (my $row = $csv->getline ($fh)) {
# do something with @$row
}
- close $fh or die "file.csv: $!";;
+ $csv->eof or $csv->error_diag;
+ close $fh or die "file.csv: $!";
For more extended examples, see the C<examples/> subdirectory in the
original distribution. Included is C<examples/parser-xs.pl>, that could
-be used to `fix' bad CSV
+be used to `fix' bad CSV and parse beyond errors.
perl examples/parser-xs.pl bad.csv >good.csv
+
+=head1 CAVEATS
+
+C<Text::CSV_XS> is not designed to detect the characters used for field
+separation and quoting. The parsing is done using predefined settings. In
+the examples subdirectory, you can find scripts that demonstrate how you
+can try to detect these characters yourself.
+
+=head2 Microsoft Excel
+
+The import/export from Microsoft Excel is a I<risky task>, according to the
+documentation in C<Text::CSV::Separator>. Microsoft uses the system's default
+list separator defined in the regional settings, which happens to be a
+semicolon for Dutch, German and Spanish (and probably some others as well).
+For the English locale, the default is a comma. In Windows however, the user
+is free to choose a predefined locale, and then change every individual
+setting in it, so checking the locale is no solution.
=head1 TODO
@@ -1268,14 +1289,6 @@
Basic calls should croak or warn on illegal parameters. Errors should be
documented.
-
-=item eol
-
-Discuss an option to make the eol honor the $/ setting. Maybe
-
- my $csv = Text::CSV_XS->new ({ eol => $/ });
-
-is already enough, and new options only make things less opaque.
=item setting meta info
@@ -1468,7 +1481,7 @@
=item 2027 "EIQ - Quoted field not terminated"
When parsing a field that started with a quotation character, the field is
-expected to be closed with a quotation charater. When the parsed line is
+expected to be closed with a quotation character. When the parsed line is
exhausted before the quote is found, that field is not terminated.
=item 2030 "EIF - NL char inside unquoted verbatim, binary off"
@@ -1507,8 +1520,9 @@
=head1 SEE ALSO
-L<perl(1)>, L<IO::File(3)>, L{IO::Handle(3)>, L<IO::Wrap(3)>,
-L<Text::CSV(3)>, L<Text::CSV_PP(3)>. and L<Spreadsheet::Read(3)>.
+L<perl(1)>, L<IO::File(3)>, L<IO::Handle(3)>, L<IO::Wrap(3)>,
+L<Text::CSV(3)>, L<Text::CSV_PP(3)>, L<Text::CSV::Separator(3)>,
+and L<Spreadsheet::Read(3)>.
=head1 AUTHORS and MAINTAINERS
Modified: branches/upstream/libtext-csv-xs-perl/current/CSV_XS.xs
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-csv-xs-perl/current/CSV_XS.xs?rev=26136&op=diff
==============================================================================
--- branches/upstream/libtext-csv-xs-perl/current/CSV_XS.xs (original)
+++ branches/upstream/libtext-csv-xs-perl/current/CSV_XS.xs Sat Oct 18 11:40:00 2008
@@ -177,21 +177,31 @@
io_handle_loaded = 1; \
}
-static SV *SetDiag (csv_t *csv, int xse)
+static SV *SvDiag (int xse)
{
int i = 0;
- SV *err = NULL;
+ SV *err;
while (xs_errors[i].xs_errno && xs_errors[i].xs_errno != xse) i++;
if ((err = newSVpv (xs_errors[i].xs_errstr, 0))) {
SvUPGRADE (err, SVt_PVIV);
SvIV_set (err, xse);
SvIOK_on (err);
- hv_store (csv->self, "_ERROR_DIAG", 11, err, 0);
+ }
+ return (err);
+ } /* SvDiag */
+
+static SV *SetDiag (csv_t *csv, int xse)
+{
+ int i = 0;
+ SV *err = SvDiag (xse);
+
+ if (err) {
+ hv_store (csv->self, "_ERROR_DIAG", 11, err, 0);
}
if (xse == 0) {
- hv_store (csv->self, "_ERROR_POS", 10, newSViv (0), 0);
- hv_store (csv->self, "_ERROR_INPUT", 12, newSVpvs (""), 0);
+ hv_store (csv->self, "_ERROR_POS", 10, newSViv (0), 0);
+ hv_store (csv->self, "_ERROR_INPUT", 12, newSVpvs (""), 0);
}
return (err);
} /* SetDiag */
@@ -363,7 +373,7 @@
if (result) {
result = POPi;
unless (result)
- SetDiag (csv, 2200);
+ (void)SetDiag (csv, 2200);
}
PUTBACK;
SvREFCNT_dec (tmp);
@@ -631,7 +641,7 @@
}
}
}
- SetDiag (csv, 3008);
+ (void)SetDiag (csv, 3008);
return (NULL);
} /* bound_field */
@@ -1147,9 +1157,13 @@
HV *hv;
csv_t csv;
- CSV_XS_SELF;
- SetupCsv (&csv, hv);
- ST (0) = SetDiag (&csv, xse);
+ if (SvOK (self) && SvROK (self)) {
+ CSV_XS_SELF;
+ SetupCsv (&csv, hv);
+ ST (0) = SetDiag (&csv, xse);
+ }
+ else
+ ST (0) = SvDiag (xse);
XSRETURN (1);
/* XS SetDiag */
Modified: branches/upstream/libtext-csv-xs-perl/current/ChangeLog
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-csv-xs-perl/current/ChangeLog?rev=26136&op=diff
==============================================================================
--- branches/upstream/libtext-csv-xs-perl/current/ChangeLog (original)
+++ branches/upstream/libtext-csv-xs-perl/current/ChangeLog Sat Oct 18 11:40:00 2008
@@ -1,3 +1,12 @@
+2008-10-15 0.55 - H.Merijn Brand <h.m.brand at xs4all.nl>
+
+ * Improve documentation on eol
+ * Unicode on perl-5.8.[0-2] sucks. Don't use it!
+ * Test error codes in expected IO failures
+ * Allow SetDiag to be used as class method
+ * Document the MS/Excel separation character
+ * Hint that eof is not an error per se (RT#40047)
+
2008-09-04 0.54 - H.Merijn Brand <h.m.brand at xs4all.nl>
* IO failure in print () was not propagated (ilmari, RT#38960)
Modified: branches/upstream/libtext-csv-xs-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-csv-xs-perl/current/META.yml?rev=26136&op=diff
==============================================================================
--- branches/upstream/libtext-csv-xs-perl/current/META.yml (original)
+++ branches/upstream/libtext-csv-xs-perl/current/META.yml Sat Oct 18 11:40:00 2008
@@ -1,6 +1,6 @@
--- #YAML:1.4
name: Text-CSV_XS
-version: 0.54
+version: 0.55
abstract: Comma-Separated Values manipulation routines
license: perl
author:
@@ -10,7 +10,7 @@
provides:
Text::CSV_XS:
file: CSV_XS.pm
- version: 0.54
+ version: 0.55
requires:
perl: 5.005
DynaLoader: 0
Modified: branches/upstream/libtext-csv-xs-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-csv-xs-perl/current/Makefile.PL?rev=26136&op=diff
==============================================================================
--- branches/upstream/libtext-csv-xs-perl/current/Makefile.PL (original)
+++ branches/upstream/libtext-csv-xs-perl/current/Makefile.PL Sat Oct 18 11:40:00 2008
@@ -92,6 +92,7 @@
'tgzdist: checkmeta fixmeta $(DISTVNAME).tar.gz distcheck',
' - at mv -f $(DISTVNAME).tar.gz $(DISTVNAME).tgz',
' - at cpants_lint.pl $(DISTVNAME).tgz',
+ ' - at rm -f Debian_CPANTS.txt',
'',
'test_speed: pure_all',
' PERL_DL_NONLAZY=1 $(FULLPERLRUN) -I"$(INST_LIB)" -I"$(INST_ARCHLIB)" examples/speed.pl',
Modified: branches/upstream/libtext-csv-xs-perl/current/t/20_file.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-csv-xs-perl/current/t/20_file.t?rev=26136&op=diff
==============================================================================
--- branches/upstream/libtext-csv-xs-perl/current/t/20_file.t (original)
+++ branches/upstream/libtext-csv-xs-perl/current/t/20_file.t Sat Oct 18 11:40:00 2008
@@ -2,16 +2,22 @@
use strict;
$^W = 1; # use warnings;
-$| = 1;
-use Test::More tests => 82;
+use Test::More tests => 105;
BEGIN {
use_ok "Text::CSV_XS";
plan skip_all => "Cannot load Text::CSV_XS" if $@;
+ require "t/util.pl";
}
+$| = 1;
+$/ = "\n";
+$\ = undef;
+
my $csv = Text::CSV_XS->new ();
+
+my $UTF8 = ($ENV{LANG} || "C").($ENV{LC_ALL} || "C") =~ m/utf-?8/i ? 1 : 0;
ok (!$csv->print (*FH, ["abc", "def\007", "ghi"]), "print bad character");
@@ -99,40 +105,43 @@
# Edge cases
$csv = Text::CSV_XS->new ({ escape_char => "+" });
-for ([ 1, 1, "\n" ],
- [ 2, 1, "+\n" ],
- [ 3, 1, "+" ],
- [ 4, 0, qq{"+"\n} ],
- [ 5, 0, qq{"+\n} ],
- [ 6, 0, qq{""+\n} ],
- [ 7, 0, qq{"+"} ],
- [ 8, 0, qq{"+} ],
- [ 9, 0, qq{""+} ],
- [ 10, 0, "\r" ],
- [ 11, 0, "\r\r" ],
- [ 12, 0, "+\r\r" ],
- [ 13, 0, "+\r\r+" ],
- [ 14, 0, qq{"\r"} ],
- [ 15, 0, qq{"\r\r" } ],
- [ 16, 0, qq{"+\r\r"} ],
- [ 17, 0, qq{"+\r\r+"} ],
- [ 14, 0, qq{"\r"\r} ],
- [ 15, 0, qq{"\r\r"\r} ],
- [ 16, 0, qq{"+\r\r"\r} ],
- [ 17, 0, qq{"+\r\r+"\r} ],
+for ([ 1, 1, 0, "\n" ],
+ [ 2, 1, 0, "+\n" ],
+ [ 3, 1, 0, "+" ],
+ [ 4, 0, 2021, qq{"+"\n} ],
+ [ 5, 0, 2025, qq{"+\n} ],
+ [ 6, 0, 2011, qq{""+\n} ],
+ [ 7, 0, 2027, qq{"+"} ],
+ [ 8, 0, 2024, qq{"+} ],
+ [ 9, 0, 2011, qq{""+} ],
+ [ 10, 0, 2037, "\r" ],
+ [ 11, 0, 2031, "\r\r" ],
+ [ 12, 0, 2032, "+\r\r" ],
+ [ 13, 0, 2032, "+\r\r+" ],
+ [ 14, 0, 2022, qq{"\r"} ],
+ [ 15, 0, 2022, qq{"\r\r" } ],
+ [ 16, 0, 2022, qq{"\r\r"\t} ],
+ [ 17, 0, 2025, qq{"+\r\r"} ],
+ [ 18, 0, 2025, qq{"+\r\r+"} ],
+ [ 19, 0, 2022, qq{"\r"\r} ],
+ [ 20, 0, 2022, qq{"\r\r"\r} ],
+ [ 21, 0, 2025, qq{"+\r\r"\r} ],
+ [ 22, 0, 2025, qq{"+\r\r+"\r} ],
) {
- my ($tst, $valid, $str) = @$_;
+ my ($tst, $valid, $err, $str) = @$_;
open FH, ">_test.csv" or die "_test.csv: $!";
print FH $str;
close FH;
open FH, "<_test.csv" or die "_test.csv: $!";
my $row = $csv->getline (*FH);
close FH;
- if ($valid) {
- ok ( $row, "$tst - getline ESC");
- }
- else {
- ok (!$row, "$tst - getline ESC");
+ my @err = $csv->error_diag;
+ my $sstr = _readable ($str);
+ SKIP: {
+ $tst == 10 && $] >= 5.008 && $] < 5.008003 && $UTF8 and
+ skip "Be reasonable, this perl version does not do Unicode reliable", 2;
+ ok ($valid ? $row : !$row, "$tst - getline ESC +, '$sstr'");
+ is ($err[0], $err, "Error expected $err");
}
}
Modified: branches/upstream/libtext-csv-xs-perl/current/t/21_lexicalio.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-csv-xs-perl/current/t/21_lexicalio.t?rev=26136&op=diff
==============================================================================
--- branches/upstream/libtext-csv-xs-perl/current/t/21_lexicalio.t (original)
+++ branches/upstream/libtext-csv-xs-perl/current/t/21_lexicalio.t Sat Oct 18 11:40:00 2008
@@ -2,7 +2,6 @@
use strict;
$^W = 1; # use warnings;
-$| = 1;
use Test::More;
@@ -11,17 +10,24 @@
plan skip_all => "No lexical file handles in in this ancient perl version";
}
else {
- plan tests => 82;
+ plan tests => 105;
}
}
BEGIN {
use_ok "Text::CSV_XS";
plan skip_all => "Cannot load Text::CSV_XS" if $@;
+ require "t/util.pl";
}
+
+$| = 1;
+$/ = "\n";
+$\ = undef;
my $io;
my $csv = Text::CSV_XS->new ();
+
+my $UTF8 = ($ENV{LANG} || "C").($ENV{LC_ALL} || "C") =~ m/utf-?8/i ? 1 : 0;
ok (!$csv->print ($io, ["abc", "def\007", "ghi"]), "print bad character");
@@ -109,39 +115,44 @@
# Edge cases
$csv = Text::CSV_XS->new ({ escape_char => "+" });
-for ([ 1, 1, "\n" ],
- [ 2, 1, "+\n" ],
- [ 3, 1, "+" ],
- [ 4, 0, qq{"+"\n} ],
- [ 5, 0, qq{"+\n} ],
- [ 6, 0, qq{""+\n} ],
- [ 7, 0, qq{"+"} ],
- [ 8, 0, qq{"+} ],
- [ 9, 0, qq{""+} ],
- [ 10, 0, "\r" ],
- [ 11, 0, "\r\r" ],
- [ 12, 0, "+\r\r" ],
- [ 13, 0, "+\r\r+" ],
- [ 14, 0, qq{"\r"} ],
- [ 15, 0, qq{"\r\r" } ],
- [ 16, 0, qq{"+\r\r"} ],
- [ 17, 0, qq{"+\r\r+"} ],
- [ 14, 0, qq{"\r"\r} ],
- [ 15, 0, qq{"\r\r"\r} ],
- [ 16, 0, qq{"+\r\r"\r} ],
- [ 17, 0, qq{"+\r\r+"\r} ],
+for ([ 1, 1, 0, "\n" ],
+ [ 2, 1, 0, "+\n" ],
+ [ 3, 1, 0, "+" ],
+ [ 4, 0, 2021, qq{"+"\n} ],
+ [ 5, 0, 2025, qq{"+\n} ],
+ [ 6, 0, 2011, qq{""+\n} ],
+ [ 7, 0, 2027, qq{"+"} ],
+ [ 8, 0, 2024, qq{"+} ],
+ [ 9, 0, 2011, qq{""+} ],
+ [ 10, 0, 2037, "\r" ],
+ [ 11, 0, 2031, "\r\r" ],
+ [ 12, 0, 2032, "+\r\r" ],
+ [ 13, 0, 2032, "+\r\r+" ],
+ [ 14, 0, 2022, qq{"\r"} ],
+ [ 15, 0, 2022, qq{"\r\r" } ],
+ [ 16, 0, 2022, qq{"\r\r"\t} ],
+ [ 17, 0, 2025, qq{"+\r\r"} ],
+ [ 18, 0, 2025, qq{"+\r\r+"} ],
+ [ 19, 0, 2022, qq{"\r"\r} ],
+ [ 20, 0, 2022, qq{"\r\r"\r} ],
+ [ 21, 0, 2025, qq{"+\r\r"\r} ],
+ [ 22, 0, 2025, qq{"+\r\r+"\r} ],
) {
- my ($tst, $valid, $str) = @$_;
+ my ($tst, $valid, $err, $str) = @$_;
open my $io, ">_test.csv" or die "_test.csv: $!";
print $io $str;
close $io;
open $io, "<_test.csv" or die "_test.csv: $!";
my $row = $csv->getline ($io);
close $io;
- if ($valid) {
- ok ( $row, "$tst - getline ESC");
- }
- else {
- ok (!$row, "$tst - getline ESC");
+ my @err = $csv->error_diag;
+ my $sstr = _readable ($str);
+ SKIP: {
+ $tst == 10 && $] >= 5.008 && $] < 5.008003 && $UTF8 and
+ skip "Be reasonable, this perl version does not do Unicode reliable", 2;
+ ok ($valid ? $row : !$row, "$tst - getline ESC +, '$sstr'");
+ is ($err[0], $err, "Error expected $err");
}
}
+
+unlink "_test.csv";
Modified: branches/upstream/libtext-csv-xs-perl/current/t/22_scalario.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-csv-xs-perl/current/t/22_scalario.t?rev=26136&op=diff
==============================================================================
--- branches/upstream/libtext-csv-xs-perl/current/t/22_scalario.t (original)
+++ branches/upstream/libtext-csv-xs-perl/current/t/22_scalario.t Sat Oct 18 11:40:00 2008
@@ -14,14 +14,18 @@
plan skip_all => "No perlIO available";
}
else {
- plan tests => 82;
+ plan tests => 105;
}
}
BEGIN {
use_ok "Text::CSV_XS";
plan skip_all => "Cannot load Text::CSV_XS" if $@;
+ require "t/util.pl";
}
+
+$/ = "\n";
+$\ = undef;
my $io;
my $io_str;
@@ -113,39 +117,36 @@
# Edge cases
$csv = Text::CSV_XS->new ({ escape_char => "+" });
-for ([ 1, 1, "\n" ],
- [ 2, 1, "+\n" ],
- [ 3, 1, "+" ],
- [ 4, 0, qq{"+"\n} ],
- [ 5, 0, qq{"+\n} ],
- [ 6, 0, qq{""+\n} ],
- [ 7, 0, qq{"+"} ],
- [ 8, 0, qq{"+} ],
- [ 9, 0, qq{""+} ],
- [ 10, 0, "\r" ],
- [ 11, 0, "\r\r" ],
- [ 12, 0, "+\r\r" ],
- [ 13, 0, "+\r\r+" ],
- [ 14, 0, qq{"\r"} ],
- [ 15, 0, qq{"\r\r" } ],
- [ 16, 0, qq{"+\r\r"} ],
- [ 17, 0, qq{"+\r\r+"} ],
- [ 14, 0, qq{"\r"\r} ],
- [ 15, 0, qq{"\r\r"\r} ],
- [ 16, 0, qq{"+\r\r"\r} ],
- [ 17, 0, qq{"+\r\r+"\r} ],
+for ([ 1, 1, 0, "\n" ],
+ [ 2, 1, 0, "+\n" ],
+ [ 3, 1, 0, "+" ],
+ [ 4, 0, 2021, qq{"+"\n} ],
+ [ 5, 0, 2025, qq{"+\n} ],
+ [ 6, 0, 2011, qq{""+\n} ],
+ [ 7, 0, 2027, qq{"+"} ],
+ [ 8, 0, 2024, qq{"+} ],
+ [ 9, 0, 2011, qq{""+} ],
+ [ 10, 0, 2037, "\r" ],
+ [ 11, 0, 2031, "\r\r" ],
+ [ 12, 0, 2032, "+\r\r" ],
+ [ 13, 0, 2032, "+\r\r+" ],
+ [ 14, 0, 2022, qq{"\r"} ],
+ [ 15, 0, 2022, qq{"\r\r" } ],
+ [ 16, 0, 2022, qq{"\r\r"\t} ],
+ [ 17, 0, 2025, qq{"+\r\r"} ],
+ [ 18, 0, 2025, qq{"+\r\r+"} ],
+ [ 19, 0, 2022, qq{"\r"\r} ],
+ [ 20, 0, 2022, qq{"\r\r"\r} ],
+ [ 21, 0, 2025, qq{"+\r\r"\r} ],
+ [ 22, 0, 2025, qq{"+\r\r+"\r} ],
) {
- my ($tst, $valid, $str) = @$_;
- open my $io, ">", \$io_str or die "_test.csv: $!";
- print $io $str;
- close $io;
- open $io, "<", \$io_str or die "_test.csv: $!";
+ my ($tst, $valid, $err, $str) = @$_;
+ $io_str = $str;
+ open $io, "<", \$io_str or die "_test.csv: $!";
my $row = $csv->getline ($io);
close $io;
- if ($valid) {
- ok ( $row, "$tst - getline ESC");
- }
- else {
- ok (!$row, "$tst - getline ESC");
- }
+ my @err = $csv->error_diag;
+ my $sstr = _readable ($str);
+ ok ($valid ? $row : !$row, "$tst - getline ESC +, '$sstr'");
+ is ($err[0], $err, "Error expected $err");
}
Modified: branches/upstream/libtext-csv-xs-perl/current/t/65_allow.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-csv-xs-perl/current/t/65_allow.t?rev=26136&op=diff
==============================================================================
--- branches/upstream/libtext-csv-xs-perl/current/t/65_allow.t (original)
+++ branches/upstream/libtext-csv-xs-perl/current/t/65_allow.t Sat Oct 18 11:40:00 2008
@@ -4,7 +4,7 @@
$^W = 1;
#use Test::More "no_plan";
- use Test::More tests => 838;
+ use Test::More tests => 1018;
BEGIN {
use_ok "Text::CSV_XS", ();
@@ -18,18 +18,19 @@
# Allow unescaped quotes inside an unquoted field
{ my @bad = (
# valid, line
- [ 1, 1, qq{foo,bar,"baz",quux}, ],
- [ 2, 0, qq{rj,bs,r"jb"s,rjbs}, ],
- [ 3, 0, qq{some "spaced" quote data,2,3,4}, ],
- [ 4, 1, qq{and an,entirely,quoted,"field"}, ],
- [ 5, 1, qq{and then,"one with ""quoted"" quotes",okay,?}, ],
+ [ 1, 1, 0, qq{foo,bar,"baz",quux} ],
+ [ 2, 0, 2034, qq{rj,bs,r"jb"s,rjbs} ],
+ [ 3, 0, 2034, qq{some "spaced" quote data,2,3,4} ],
+ [ 4, 1, 0, qq{and an,entirely,quoted,"field"} ],
+ [ 5, 1, 0, qq{and then,"one with ""quoted"" quotes",okay,?} ],
);
for (@bad) {
- my ($tst, $valid, $bad) = @$_;
+ my ($tst, $valid, $err, $bad) = @$_;
$csv = Text::CSV_XS->new ();
ok ($csv, "$tst - new (alq => 0)");
is ($csv->parse ($bad), $valid, "$tst - parse () fail");
+ is (0 + $csv->error_diag, $err, "$tst - error $err");
$csv->allow_loose_quotes (1);
ok ($csv->parse ($bad), "$tst - parse () pass");
@@ -44,21 +45,23 @@
# Allow unescaped quotes inside a quoted field
{ my @bad = (
# valid, line
- [ 1, 1, qq{foo,bar,"baz",quux}, ],
- [ 2, 0, qq{rj,bs,"r"jb"s",rjbs}, ],
- [ 3, 0, qq{"some "spaced" quote data",2,3,4}, ],
- [ 4, 1, qq{and an,entirely,quoted,"field"}, ],
- [ 5, 1, qq{and then,"one with ""quoted"" quotes",okay,?}, ],
+ [ 1, 1, 0, qq{foo,bar,"baz",quux} ],
+ [ 2, 0, 2023, qq{rj,bs,"r"jb"s",rjbs} ],
+ [ 3, 0, 2023, qq{"some "spaced" quote data",2,3,4} ],
+ [ 4, 1, 0, qq{and an,entirely,quoted,"field"} ],
+ [ 5, 1, 0, qq{and then,"one with ""quoted"" quotes",okay,?} ],
);
for (@bad) {
- my ($tst, $valid, $bad) = @$_;
+ my ($tst, $valid, $err, $bad) = @$_;
$csv = Text::CSV_XS->new ();
ok ($csv, "$tst - new (alq => 0)");
is ($csv->parse ($bad), $valid, "$tst - parse () fail");
+ is (0 + $csv->error_diag, $err, "$tst - error $err");
$csv->allow_loose_quotes (1);
is ($csv->parse ($bad), $valid, "$tst - parse () fail with lq");
+ is (0 + $csv->error_diag, $err, "$tst - error $err");
$csv->escape_char (undef);
ok ($csv->parse ($bad), "$tst - parse () pass");
@@ -70,27 +73,29 @@
# Allow escapes to escape characters that should not be escaped
{ my @bad = (
# valid, line
- [ 1, 1, qq{1,foo,bar,"baz",quux}, ],
- [ 2, 1, qq{2,escaped,"quote\\"s",in,"here"}, ],
- [ 3, 1, qq{3,escaped,quote\\"s,in,"here"}, ],
- [ 4, 1, qq{4,escap\\'d chars,allowed,in,unquoted,fields}, ],
- [ 5, 0, qq{5,42,"and it\\'s dog",}, ],
-
- [ 6, 1, qq{\\,}, ],
- [ 7, 1, qq{\\}, ],
- [ 8, 0, qq{foo\\}, ],
+ [ 1, 1, 0, qq{1,foo,bar,"baz",quux} ],
+ [ 2, 1, 0, qq{2,escaped,"quote\\"s",in,"here"} ],
+ [ 3, 1, 0, qq{3,escaped,quote\\"s,in,"here"} ],
+ [ 4, 1, 0, qq{4,escap\\'d chars,allowed,in,unquoted,fields} ],
+ [ 5, 0, 2025, qq{5,42,"and it\\'s dog",} ],
+
+ [ 6, 1, 0, qq{\\,} ],
+ [ 7, 1, 0, qq{\\} ],
+ [ 8, 0, 2035, qq{foo\\} ],
);
for (@bad) {
- my ($tst, $valid, $bad) = @$_;
+ my ($tst, $valid, $err, $bad) = @$_;
$csv = Text::CSV_XS->new ({ escape_char => "\\" });
ok ($csv, "$tst - new (ale => 0)");
is ($csv->parse ($bad), $valid, "$tst - parse () fail");
+ is (0 + $csv->error_diag, $err, "$tst - error $err");
$csv->allow_loose_escapes (1);
if ($tst >= 8) {
# Should always fail
ok (!$csv->parse ($bad), "$tst - parse () fail");
+ is (0 + $csv->error_diag, $err, "$tst - error $err");
}
else {
ok ($csv->parse ($bad), "$tst - parse () pass");
@@ -103,28 +108,29 @@
# Allow whitespace to surround sep char
{ my @bad = (
# valid, line
- [ 1, 1, qq{1,foo,bar,baz,quux}, ],
- [ 2, 1, qq{1,foo,bar,"baz",quux}, ],
- [ 3, 1, qq{1, foo,bar,"baz",quux}, ],
- [ 4, 1, qq{ 1,foo,bar,"baz",quux}, ],
- [ 5, 0, qq{1,foo,bar, "baz",quux}, ],
- [ 6, 1, qq{1,foo ,bar,"baz",quux}, ],
- [ 7, 1, qq{1,foo,bar,"baz",quux }, ],
- [ 8, 1, qq{1,foo,bar,"baz","quux"}, ],
- [ 9, 0, qq{1,foo,bar,"baz" ,quux}, ],
- [ 10, 0, qq{1,foo,bar,"baz","quux" }, ],
- [ 11, 0, qq{ 1 , foo , bar , "baz" , quux }, ],
- [ 12, 0, qq{ 1 , foo , bar , "baz" , quux }, ],
- [ 13, 0, qq{ 1 , foo , bar , "baz"\t , quux }, ],
+ [ 1, 1, 0, qq{1,foo,bar,baz,quux} ],
+ [ 2, 1, 0, qq{1,foo,bar,"baz",quux} ],
+ [ 3, 1, 0, qq{1, foo,bar,"baz",quux} ],
+ [ 4, 1, 0, qq{ 1,foo,bar,"baz",quux} ],
+ [ 5, 0, 2034, qq{1,foo,bar, "baz",quux} ],
+ [ 6, 1, 0, qq{1,foo ,bar,"baz",quux} ],
+ [ 7, 1, 0, qq{1,foo,bar,"baz",quux } ],
+ [ 8, 1, 0, qq{1,foo,bar,"baz","quux"} ],
+ [ 9, 0, 2023, qq{1,foo,bar,"baz" ,quux} ],
+ [ 10, 0, 2023, qq{1,foo,bar,"baz","quux" } ],
+ [ 11, 0, 2034, qq{ 1 , foo , bar , "baz" , quux } ],
+ [ 12, 0, 2034, qq{ 1 , foo , bar , "baz" , quux } ],
+ [ 13, 0, 2034, qq{ 1 , foo , bar , "baz"\t , quux } ],
);
foreach my $eol ("", "\n", "\r", "\r\n") {
my $s_eol = _readable ($eol);
for (@bad) {
- my ($tst, $ok, $bad) = @$_;
+ my ($tst, $ok, $err, $bad) = @$_;
$csv = Text::CSV_XS->new ({ eol => $eol, binary => 1 });
ok ($csv, "$s_eol / $tst - new - '$bad')");
is ($csv->parse ($bad), $ok, "$s_eol / $tst - parse () fail");
+ is (0 + $csv->error_diag, $err, "$tst - error $err");
$csv->allow_whitespace (1);
ok ($csv->parse ("$bad$eol"), "$s_eol / $tst - parse () pass");
@@ -141,32 +147,33 @@
# Allow whitespace to surround sep char
{ my @bad = (
# test, ok, line
- [ 1, 1, qq{1,foo,bar,baz,quux}, ],
- [ 2, 1, qq{1,foo,bar,"baz",quux}, ],
- [ 3, 1, qq{1, foo,bar,"baz",quux}, ],
- [ 4, 1, qq{ 1,foo,bar,"baz",quux}, ],
- [ 5, 0, qq{1,foo,bar, "baz",quux}, ],
- [ 6, 1, qq{1,foo ,bar,"baz",quux}, ],
- [ 7, 1, qq{1,foo,bar,"baz",quux }, ],
- [ 8, 1, qq{1,foo,bar,"baz","quux"}, ],
- [ 9, 0, qq{1,foo,bar,"baz" ,quux}, ],
- [ 10, 0, qq{1,foo,bar,"baz","quux" }, ],
- [ 11, 0, qq{1,foo,bar,"baz","quux" }, ],
- [ 12, 0, qq{ 1 , foo , bar , "baz" , quux }, ],
- [ 13, 0, qq{ 1 , foo , bar , "baz" , quux }, ],
- [ 14, 0, qq{ 1 , foo , bar , "baz"\t , quux }, ],
+ [ 1, 1, 0, qq{1,foo,bar,baz,quux} ],
+ [ 2, 1, 0, qq{1,foo,bar,"baz",quux} ],
+ [ 3, 1, 0, qq{1, foo,bar,"baz",quux} ],
+ [ 4, 1, 0, qq{ 1,foo,bar,"baz",quux} ],
+ [ 5, 0, 2034, qq{1,foo,bar, "baz",quux} ],
+ [ 6, 1, 0, qq{1,foo ,bar,"baz",quux} ],
+ [ 7, 1, 0, qq{1,foo,bar,"baz",quux } ],
+ [ 8, 1, 0, qq{1,foo,bar,"baz","quux"} ],
+ [ 9, 0, 2023, qq{1,foo,bar,"baz" ,quux} ],
+ [ 10, 0, 2023, qq{1,foo,bar,"baz","quux" } ],
+ [ 11, 0, 2023, qq{1,foo,bar,"baz","quux" } ],
+ [ 12, 0, 2034, qq{ 1 , foo , bar , "baz" , quux } ],
+ [ 13, 0, 2034, qq{ 1 , foo , bar , "baz" , quux } ],
+ [ 14, 0, 2034, qq{ 1 , foo , bar , "baz"\t , quux } ],
);
foreach my $eol ("", "\n", "\r", "\r\n") {
my $s_eol = _readable ($eol);
for (@bad) {
- my ($tst, $ok, $bad) = @$_;
+ my ($tst, $ok, $err, $bad) = @$_;
$csv = Text::CSV_XS->new ({
eol => $eol,
binary => 1,
});
ok ($csv, "$s_eol / $tst - new - '$bad')");
is ($csv->parse ($bad), $ok, "$s_eol / $tst - parse () fail");
+ is (0 + $csv->error_diag, $err, "$tst - error $err");
$csv->allow_whitespace (1);
ok ($csv->parse ("$bad$eol"), "$s_eol / $tst - parse () pass");
@@ -211,21 +218,25 @@
ok ($csv, "$s_eol - new ()");
my @bad = (
# test, line
- [ 1, qq{"\r\r\n"\r}, ],
- [ 2, qq{"\r\r\n"\r\r}, ],
- [ 3, qq{"\r\r\n"\r\r\n}, ],
- [ 4, qq{"\r\r\n"\t \r}, ],
- [ 5, qq{"\r\r\n"\t \r\r}, ],
- [ 6, qq{"\r\r\n"\t \r\r\n}, ],
+ [ 1, qq{"\r\r\n"\r} ],
+ [ 2, qq{"\r\r\n"\r\r} ],
+ [ 3, qq{"\r\r\n"\r\r\n} ],
+ [ 4, qq{"\r\r\n"\t \r} ],
+ [ 5, qq{"\r\r\n"\t \r\r} ],
+ [ 6, qq{"\r\r\n"\t \r\r\n} ],
);
+ my @pass = ( 0, 0, 0, 1 );
+ my @fail = ( 2022, 2022, 2023, 0 );
foreach my $arg (@bad) {
my ($tst, $bad) = @$arg;
- my $ok = ($bin and $eol) ? 1 : 0;
- is ($csv->parse ($bad), $ok, "$tst - parse () default");
+ my $ok = ($bin << 1) | ($eol ? 1 : 0);
+ is ($csv->parse ($bad), $pass[$ok], "$tst $ok - parse () default");
+ is (0 + $csv->error_diag, $fail[$ok], "$tst $ok - error $fail[$ok]");
$csv->allow_whitespace (1);
- is ($csv->parse ($bad), $ok, "$tst - parse () allow");
+ is ($csv->parse ($bad), $pass[$ok], "$tst $ok - parse () allow");
+ is (0 + $csv->error_diag, $fail[$ok], "$tst $ok - error $fail[$ok]");
}
}
}
@@ -323,7 +334,7 @@
close FH;
open FH, "<_test.csv";
is ($csv->getline (*FH), undef, "#\\r\\n $gc getline 2030");
- is (0 + $csv->error_diag (), 2030, "Got 2030");
+ is (0 + $csv->error_diag, 2030, "Got 2030");
close FH;
unlink "_test.csv";
@@ -366,12 +377,12 @@
my $s2023 = qq{2023,",2008-04-05," \tFoo, Bar",\n}; # "
# ^
- is ($csv->parse ($s2023), 0, "Parse 2023");
- is (($csv->error_diag ())[0], 2023, "Fail code 2023");
- is (($csv->error_diag ())[2], 19, "Fail position");
-
- is ($csv->allow_whitespace (1), 1, "Allow whitespace");
- is ($csv->parse ($s2023), 0, "Parse 2023");
- is (($csv->error_diag ())[0], 2023, "Fail code 2023");
- is (($csv->error_diag ())[2], 22, "Space is eaten now");
- }
+ is ( $csv->parse ($s2023), 0, "Parse 2023");
+ is (($csv->error_diag)[0], 2023, "Fail code 2023");
+ is (($csv->error_diag)[2], 19, "Fail position");
+
+ is ( $csv->allow_whitespace (1), 1, "Allow whitespace");
+ is ( $csv->parse ($s2023), 0, "Parse 2023");
+ is (($csv->error_diag)[0], 2023, "Fail code 2023");
+ is (($csv->error_diag)[2], 22, "Space is eaten now");
+ }
Modified: branches/upstream/libtext-csv-xs-perl/current/t/70_rt.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-csv-xs-perl/current/t/70_rt.t?rev=26136&op=diff
==============================================================================
--- branches/upstream/libtext-csv-xs-perl/current/t/70_rt.t (original)
+++ branches/upstream/libtext-csv-xs-perl/current/t/70_rt.t Sat Oct 18 11:40:00 2008
@@ -127,8 +127,7 @@
local $SIG{__WARN__} = sub { $err = "Warning" };
ok (!$csv->print (*FH, [ 1 .. 4 ]), "print ()");
is ($err, "Warning", "IO::Handle triggered a warning");
- my @err = $csv->error_diag ();
- is ($err[0], 2200, "error 2200");
+ is (($csv->error_diag)[0], 2200, "error 2200");
close FH;
unlink $csv_file;
}
More information about the Pkg-perl-cvs-commits
mailing list