r19025 - in /branches/upstream/libtext-csv-perl/current: CSV_XS.pm CSV_XS.xs ChangeLog MANIFEST META.yml Makefile.PL examples/csv-check examples/csv2xls t/65_allow.t t/76_magic.t t/80_diag.t

gregoa at users.alioth.debian.org gregoa at users.alioth.debian.org
Tue Apr 22 19:11:01 UTC 2008


Author: gregoa
Date: Tue Apr 22 19:11:01 2008
New Revision: 19025

URL: http://svn.debian.org/wsvn/?sc=1&rev=19025
Log:
[svn-upgrade] Integrating new upstream version, libtext-csv-perl (0.43)

Added:
    branches/upstream/libtext-csv-perl/current/examples/csv-check   (with props)
Modified:
    branches/upstream/libtext-csv-perl/current/CSV_XS.pm
    branches/upstream/libtext-csv-perl/current/CSV_XS.xs
    branches/upstream/libtext-csv-perl/current/ChangeLog
    branches/upstream/libtext-csv-perl/current/MANIFEST
    branches/upstream/libtext-csv-perl/current/META.yml
    branches/upstream/libtext-csv-perl/current/Makefile.PL
    branches/upstream/libtext-csv-perl/current/examples/csv2xls
    branches/upstream/libtext-csv-perl/current/t/65_allow.t
    branches/upstream/libtext-csv-perl/current/t/76_magic.t
    branches/upstream/libtext-csv-perl/current/t/80_diag.t

Modified: branches/upstream/libtext-csv-perl/current/CSV_XS.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libtext-csv-perl/current/CSV_XS.pm?rev=19025&op=diff
==============================================================================
--- branches/upstream/libtext-csv-perl/current/CSV_XS.pm (original)
+++ branches/upstream/libtext-csv-perl/current/CSV_XS.pm Tue Apr 22 19:11:01 2008
@@ -30,7 +30,7 @@
 use Carp;
 
 use vars   qw( $VERSION @ISA );
-$VERSION = "0.42";
+$VERSION = "0.43";
 @ISA     = qw( DynaLoader );
 
 sub PV { 0 }
@@ -267,13 +267,14 @@
 sub error_diag
 {
     my $self = shift;
-    my @diag = (0, $last_new_err);
+    my @diag = (0, $last_new_err, 0);
 
     unless ($self && ref $self) {	# Class method or direct call
 	$last_new_err and $diag[0] = 1000;
 	}
     elsif ($self->isa (__PACKAGE__) && exists $self->{_ERROR_DIAG}) {
 	@diag = (0 + $self->{_ERROR_DIAG}, $self->{_ERROR_DIAG});
+	exists $self->{_ERROR_POS} and $diag[2] = 1 + $self->{_ERROR_POS};
 	}
     my $context = wantarray;
     unless (defined $context) {	# Void context
@@ -724,6 +725,18 @@
 allow this format, we cannot help there are some vendors that make
 their applications spit out lines styled like this.
 
+In case there is B<really> bad CSV data, like
+
+ 1,"foo "bar" baz",42
+
+or
+
+ 1,""foo bar baz"",42
+
+there is a way to get that parsed, and leave the quotes inside the quoted
+field as-is. This can be achieved by setting C<allow_loose_quotes> B<AND>
+making sure that the C<escape_char> is I<not> equal to C<quote_char>.
+
 =item escape_char
 
 The character used for escaping certain characters inside quoted fields.
@@ -1089,9 +1102,9 @@
 
  Text::CSV_XS->error_diag ();
  $csv->error_diag ();
- $error_code  = 0  + $csv->error_diag ();
- $error_str   = "" . $csv->error_diag ();
- ($cde, $str) =      $csv->error_diag ();
+ $error_code   = 0  + $csv->error_diag ();
+ $error_str    = "" . $csv->error_diag ();
+ ($cde, $str, $pos) = $csv->error_diag ();
 
 If (and only if) an error occured, this function returns the diagnostics
 of that error.
@@ -1100,7 +1113,9 @@
 associated error message to STDERR.
 
 If called in list context, it will return the error code and the error
-message in that order.
+message in that order. If the last error was from parsing, the third
+value returned is the best guess at the location within the line that was
+being parsed. It's value is 1-based.
 
 If called in scalar context, it will return the diagnostics in a single
 scalar, a-la $!. It will contain the error code in numeric context, and
@@ -1109,6 +1124,12 @@
 When called as a class method or a direct function call, the error diag
 is that of the last C<new ()> call.
 
+=head2 SetDiag
+
+ $csv->SetDiag (0);
+
+Use to reset the diagnosticts if you are dealing with errors.
+
 =head1 INTERNALS
 
 =over 4
@@ -1116,8 +1137,6 @@
 =item Combine (...)
 
 =item Parse (...)
-
-=item SetDiag (...)
 
 =back
 
@@ -1187,6 +1206,9 @@
       }
   close $fh;
 
+For more extended examples, see the C<examples/> subdirectory in the
+original distribution.
+
 =head1 TODO
 
 =over 2
@@ -1395,8 +1417,8 @@
 
 =item 2023 "EIQ - QUO ..."
 
-I have not been able yet to generate this error. Please inform me how you
-got it when you get it.
+Sequences like C<"foo "bar" baz",quux> and C<2023,",2008-04-05,"Foo, Bar",\n>
+will cause this error.
 
 =item 2024 "EIQ - EOF cannot be escaped, not even inside quotes"
 

Modified: branches/upstream/libtext-csv-perl/current/CSV_XS.xs
URL: http://svn.debian.org/wsvn/branches/upstream/libtext-csv-perl/current/CSV_XS.xs?rev=19025&op=diff
==============================================================================
--- branches/upstream/libtext-csv-perl/current/CSV_XS.xs (original)
+++ branches/upstream/libtext-csv-perl/current/CSV_XS.xs Tue Apr 22 19:11:01 2008
@@ -128,7 +128,7 @@
     /*  EIQ - Error Inside Quotes */
     { 2021, "EIQ - NL char inside quotes, binary off"				},
     { 2022, "EIQ - CR char inside quotes, binary off"				},
-    { 2023, "EIQ - QUO ..."							},
+    { 2023, "EIQ - QUO character not allowed"					},
     { 2024, "EIQ - EOF cannot be escaped, not even inside quotes"		},
     { 2025, "EIQ - Loose unescaped escape"					},
     { 2026, "EIQ - Binary character inside quoted field, binary off"		},
@@ -182,6 +182,8 @@
 	SvIOK_on (err);
 	hv_store (csv->self, "_ERROR_DIAG", 11, err, 0);
 	}
+    if (xse == 0)
+	hv_store (csv->self, "_ERROR_POS",  10, newSViv (0), 0);
     return (err);
     } /* SetDiag */
 
@@ -377,11 +379,15 @@
 
 	if (i > 0)
 	    CSV_PUT (csv, dst, csv->sep_char);
-	if ((svp = av_fetch (fields, i, 0)) && *svp && SvOK (*svp)) {
+	if ((svp = av_fetch (fields, i, 0)) && *svp) {
 	    STRLEN	 len;
-	    char	*ptr = SvPV (*svp, len);
+	    char	*ptr;
 	    int		 quoteMe = csv->always_quote;
 
+	    unless ((SvOK (*svp) || (
+		    (SvMAGICAL (*svp) && (mg_get (*svp), 1) && SvOK (*svp)))
+		    )) continue;
+	    ptr = SvPV (*svp, len);
 	    /* Do we need quoting? We do quote, if the user requested
 	     * (always_quote), if binary or blank characters are found
 	     * and if the string contains quote or escape characters.
@@ -450,8 +456,9 @@
 #if MAINT_DEBUG
 static char str_parsed[40];
 #endif
-static void ParseError (csv_t *csv, int xse)
+static void ParseError (csv_t *csv, int xse, int pos)
 {
+    hv_store (csv->self, "_ERROR_POS", 10, newSViv (pos), 0);
     if (csv->tmp) {
 	if (hv_store (csv->self, "_ERROR_INPUT", 12, csv->tmp, 0))
 	    SvREFCNT_inc (csv->tmp);
@@ -507,12 +514,12 @@
 
 #define ERROR_INSIDE_QUOTES(diag_code) {	\
     SvREFCNT_dec (sv);				\
-    ParseError (csv, diag_code);		\
+    ParseError (csv, diag_code, spl);		\
     return FALSE;				\
     }
 #define ERROR_INSIDE_FIELD(diag_code) {		\
     SvREFCNT_dec (sv);				\
-    ParseError (csv, diag_code);		\
+    ParseError (csv, diag_code, spl);		\
     return FALSE;				\
     }
 
@@ -615,8 +622,8 @@
     STRLEN	 len;
     int		 seenSomething		= FALSE;
     int		 fnum			= 0;
+    int		 spl			= -1;
 #if MAINT_DEBUG
-    int		 spl			= -1;
     memset (str_parsed, 0, 40);
 #endif
 
@@ -630,8 +637,9 @@
 	NewField;
 
 	seenSomething = TRUE;
+	spl++;
 #if MAINT_DEBUG
-	if (++spl < 39) str_parsed[spl] = c;
+	if (spl < 39) str_parsed[spl] = c;
 #endif
 restart:
 	if (c == csv->sep_char) {
@@ -781,7 +789,6 @@
 
 		if (!csv->escape_char || c != csv->escape_char) {
 		    /* Field is terminated */
-		    AV_PUSH;
 		    c2 = CSV_GET;
 
 #if ALLOW_ALLOW
@@ -792,30 +799,46 @@
 			}
 #endif
 
-		    if (c2 == csv->sep_char)
+		    if (c2 == csv->sep_char) {
+			AV_PUSH;
 			continue;
-
-		    if (c2 == EOF)
+			}
+
+		    if (c2 == EOF) {
+			AV_PUSH;
 			return TRUE;
+			}
 
 		    if (c2 == CH_CR) {
 			int	c3;
 
-			if (csv->eol_is_cr)
+			if (csv->eol_is_cr) {
+			    AV_PUSH;
 /* uncovered */		    return TRUE;
+			    }
 
 			c3 = CSV_GET;
-			if (c3 == CH_NL)
+			if (c3 == CH_NL) {
+			    AV_PUSH;
 /* uncovered */		    return TRUE;
-
-			ParseError (csv, 2010);
+			    }
+
+			ParseError (csv, 2010, spl);
 			return FALSE;
 			}
 
-		    if (c2 == CH_NL)
+		    if (c2 == CH_NL) {
+			AV_PUSH;
 			return TRUE;
-
-		    ParseError (csv, 2011);
+			}
+
+		    if (csv->allow_loose_quotes) {
+			CSV_PUT_SV (sv, c);
+			c = c2;
+			goto restart;
+			}
+
+		    ParseError (csv, 2011, spl);
 		    return FALSE;
 		    }
 
@@ -865,6 +888,12 @@
 			    return TRUE;
 			    }
 			}
+
+		    if (csv->allow_loose_quotes && csv->escape_char != csv->quote_char) {
+			CSV_PUT_SV (sv, c);
+			c = c2;
+			goto restart;
+			}
 #if ALLOW_ALLOW
 		    if (csv->allow_whitespace) {
 			while (c2 == CH_SPACE || c2 == CH_TAB) {
@@ -876,6 +905,7 @@
 			    }
 			}
 #endif
+
 		    ERROR_INSIDE_QUOTES (2023);
 		    }
 		}
@@ -1105,7 +1135,7 @@
     AV	*av;
 
     CSV_XS_SELF;
-    av = (AV*)SvRV (fields);
+    av = (AV *)SvRV (fields);
     ST (0) = xsCombine (hv, av, dst, useIO) ? &PL_sv_yes : &PL_sv_undef;
     XSRETURN (1);
     /* XS Combine */

Modified: branches/upstream/libtext-csv-perl/current/ChangeLog
URL: http://svn.debian.org/wsvn/branches/upstream/libtext-csv-perl/current/ChangeLog?rev=19025&op=diff
==============================================================================
--- branches/upstream/libtext-csv-perl/current/ChangeLog (original)
+++ branches/upstream/libtext-csv-perl/current/ChangeLog Tue Apr 22 19:11:01 2008
@@ -1,3 +1,11 @@
+2008-04-21  0.43 - H.Merijn Brand   <h.m.brand at xs4all.nl>
+
+	* parse errors try to remember failing position
+	* used valgrind to test for leaks (devel-only)
+	* used Test::Valgrind as alternative leak check (devel-only)
+	* improve documentation for error 2023
+	* nailed the loose quotes in quoted fields
+
 2008-04-16  0.42 - H.Merijn Brand   <h.m.brand at xs4all.nl>
 
 	* Generate META.yml myself. I won't use Build.PL

Modified: branches/upstream/libtext-csv-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libtext-csv-perl/current/MANIFEST?rev=19025&op=diff
==============================================================================
--- branches/upstream/libtext-csv-perl/current/MANIFEST (original)
+++ branches/upstream/libtext-csv-perl/current/MANIFEST Tue Apr 22 19:11:01 2008
@@ -27,5 +27,6 @@
 t/80_diag.t		Error diagnostics
 t/util.pl		Extra test utilities
 examples/csv2xls	Script to onvert CSV files to M$Excel
+examples/csv-check	Script to check a CSV file/stream
 examples/speed.pl	Small benchmark script
 META.yml                                 Module meta-data (added by MakeMaker)

Modified: branches/upstream/libtext-csv-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libtext-csv-perl/current/META.yml?rev=19025&op=diff
==============================================================================
--- branches/upstream/libtext-csv-perl/current/META.yml (original)
+++ branches/upstream/libtext-csv-perl/current/META.yml Tue Apr 22 19:11:01 2008
@@ -1,6 +1,6 @@
 --- #YAML:1.0
 name:              Text-CSV_XS
-version:           0.42
+version:           0.43
 abstract:          Comma-Separated Values manipulation routines
 license:           perl
 author:              
@@ -10,7 +10,7 @@
 provides:
     Text::CSV_XS:
         file:      CSV_XS.pm
-        version:   0.42
+        version:   0.43
 requires:     
     perl:          5.005
     DynaLoader:    0

Modified: branches/upstream/libtext-csv-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libtext-csv-perl/current/Makefile.PL?rev=19025&op=diff
==============================================================================
--- branches/upstream/libtext-csv-perl/current/Makefile.PL (original)
+++ branches/upstream/libtext-csv-perl/current/Makefile.PL Tue Apr 22 19:11:01 2008
@@ -37,6 +37,7 @@
 			 CSV_XS.gcno
 			 CSV_XS.xs.gcov
 			 cover_db
+			 valgrind.log
 			 )
 		      },
     );
@@ -50,6 +51,19 @@
 
 sub postamble
 {
+    my $valgrind = join " ", qw(
+	PERL_DESTRUCT_LEVEL=2 PERL_DL_NONLAZY=1
+	    valgrind
+		--suppressions=sandbox/perl.supp
+		--leak-check=yes
+		--leak-resolution=high
+		--show-reachable=yes
+		--num-callers=50
+		--log-fd=3
+		$(FULLPERLRUN) "-MExtUtils::Command::MM" "-e"
+		    "test_harness($(TEST_VERBOSE), '$(INST_LIB)', '$(INST_ARCHLIB)')"
+		    $(TEST_FILES) 3>valgrind.log
+		    );
     join "\n" =>
 	'cover test_cover:',
 	'	cover -delete',
@@ -58,6 +72,13 @@
 	'	gcov CSV_XS.c 2>/dev/null',
 	'	find * -name \*.gcov -exec gcov2perl {} \;',
 	'	cover',
+	'',
+	'leakcheck:',
+	"	$valgrind",
+	'	- at tail -5 valgrind.log',
+	'',
+	'leaktest:',
+	q{	sandbox/leaktest $(FULLPERLRUN) "test_harness($(TEST_VERBOSE), '$(INST_LIB)', '$(INST_ARCHLIB)')" $(TEST_FILES)},
 	'',
 	'fixmeta:	distmeta',
 	'	perl genMETA.pl',

Added: branches/upstream/libtext-csv-perl/current/examples/csv-check
URL: http://svn.debian.org/wsvn/branches/upstream/libtext-csv-perl/current/examples/csv-check?rev=19025&op=file
==============================================================================
--- branches/upstream/libtext-csv-perl/current/examples/csv-check (added)
+++ branches/upstream/libtext-csv-perl/current/examples/csv-check Tue Apr 22 19:11:01 2008
@@ -1,0 +1,93 @@
+#!/pro/bin/perl
+
+use strict;
+use warnings;
+
+our $VERSION = "1.0";	# 2008-04-17
+
+sub usage
+{
+    my $err = shift and select STDERR;
+    print <<EOU;
+usage: csv-check [-s <sep>] [-q <quot>] [file.csv]
+       -s <sep>   use <sep>   as seperator char. Auto-detect, default = ';'
+       -q <quot>  use <quot>  as quotation char. Default = '"'
+EOU
+    exit $err;
+    } # usage
+
+use Getopt::Long qw(:config bundling nopermute passthrough);
+my $sep;	# Set after reading first line in a flurry attempt to auto-detect
+my $quo = '"';
+
+GetOptions (
+    "help|?"	=> sub { usage (0); },
+
+    "c|s=s"	=> \$sep,
+    "q=s"	=> \$quo,
+    ) or usage (1);
+
+use Text::CSV_XS;
+
+my ($bin, $rows, %cols, $firstline) = (0, 0);
+unless ($sep) { # No sep char passed, try to auto-detect;
+    while (<>) {
+	m/\S/ or next;	# Skip empty leading blank lines
+	$sep = m/["\d];["\d;]/  ? ";"  :
+	       m/["\d],["\d,]/  ? ","  :
+	       m/["\d]\t["\d,]/ ? "\t" :
+	       # If neither, then for unquoted strings
+	       m/\w;[\w;]/      ? ";"  :
+	       m/\w,[\w,]/      ? ","  :
+	       m/\w\t[\w,]/     ? "\t" :
+				  ";"  ;
+	    # Yeah I know it should be a ',' (hence Csv), but the majority
+	    # of the csv files to be shown comes from fucking Micky$hit,
+	    # that uses semiColon ';' instead.
+	$firstline = $_;
+	$rows++;
+	last;
+	}
+    }
+
+my $csv = Text::CSV_XS-> new ({
+    sep_char       => $sep,
+    quote_char     => $quo,
+    binary         => 1,
+    keep_meta_info => 1,
+    });
+
+sub done
+{
+    my @diag = $csv->error_diag;
+    if ($diag[0] == 2012 && $csv->eof) {
+	my @coll = sort { $a <=> $b } keys %cols;
+	local $" = ", ";
+	my $cols = @coll == 1 ? $coll[0] : "(@coll)";
+	print "OK: rows: $rows, columns: $cols\n";
+	print "    sep = <$sep>, quo = <$quo>, bin = <$bin>\n";
+	exit 0;
+	}
+    my $loc = $.;
+    $diag[2] and $loc .= "/$diag[2]";
+    print "$ARGV line $loc - $diag[1]\n";
+    exit $diag[0];
+    } # done
+
+sub stats
+{
+    my $r = shift;
+    $cols{scalar @$r}++;
+    grep { $_ & 0x0002 } $csv->meta_info and $bin = 1;
+    } # stats
+
+if ($firstline) {
+    $csv->parse ($_) or done;
+    stats [ $csv->fields ];
+    }
+
+while (my $row = $csv->getline (*ARGV)) {
+    $rows++;
+    stats $row;
+    }
+done;

Propchange: branches/upstream/libtext-csv-perl/current/examples/csv-check
------------------------------------------------------------------------------
    svn:executable = *

Modified: branches/upstream/libtext-csv-perl/current/examples/csv2xls
URL: http://svn.debian.org/wsvn/branches/upstream/libtext-csv-perl/current/examples/csv2xls?rev=19025&op=diff
==============================================================================
--- branches/upstream/libtext-csv-perl/current/examples/csv2xls (original)
+++ branches/upstream/libtext-csv-perl/current/examples/csv2xls Tue Apr 22 19:11:01 2008
@@ -88,9 +88,7 @@
 unless ($sep) { # No sep char passed, try to auto-detect;
     while (<>) {
 	m/\S/ or next;	# Skip empty leading blank lines
-	$sep = # If explicitely set, use it
-	       defined $sep ? $sep :
-	       # otherwise start auto-detect with quoted strings
+	$sep = # start auto-detect with quoted strings
 	       m/["\d];["\d;]/  ? ";"  :
 	       m/["\d],["\d,]/  ? ","  :
 	       m/["\d]\t["\d,]/ ? "\t" :

Modified: branches/upstream/libtext-csv-perl/current/t/65_allow.t
URL: http://svn.debian.org/wsvn/branches/upstream/libtext-csv-perl/current/t/65_allow.t?rev=19025&op=diff
==============================================================================
--- branches/upstream/libtext-csv-perl/current/t/65_allow.t (original)
+++ branches/upstream/libtext-csv-perl/current/t/65_allow.t Tue Apr 22 19:11:01 2008
@@ -4,7 +4,7 @@
 $^W = 1;
 
 #use Test::More "no_plan";
- use Test::More tests => 803;
+ use Test::More tests => 829;
 
 BEGIN {
     use_ok "Text::CSV_XS", ();
@@ -38,6 +38,32 @@
 
     #$csv = Text::CSV_XS->new ({ quote_char => '"', escape_char => "=" });
     #ok (!$csv->parse (qq{foo,d'uh"bar}),	"should fail");
+    }
+
+ok (1, "Allow loose quotes inside quoted");
+# 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,?},	],
+	);
+
+    for (@bad) {
+	my ($tst, $valid, $bad) = @$_;
+	$csv = Text::CSV_XS->new ();
+	ok ($csv,			"$tst - new (alq => 0)");
+	is ($csv->parse ($bad), $valid,	"$tst - parse () fail");
+
+	$csv->allow_loose_quotes (1);
+	is ($csv->parse ($bad), $valid,	"$tst - parse () fail with lq");
+
+	$csv->escape_char (undef);
+	ok ($csv->parse ($bad),		"$tst - parse () pass");
+	ok (my @f = $csv->fields,	"$tst - fields");
+	}
     }
 
 ok (1, "Allow loose escapes");

Modified: branches/upstream/libtext-csv-perl/current/t/76_magic.t
URL: http://svn.debian.org/wsvn/branches/upstream/libtext-csv-perl/current/t/76_magic.t?rev=19025&op=diff
==============================================================================
--- branches/upstream/libtext-csv-perl/current/t/76_magic.t (original)
+++ branches/upstream/libtext-csv-perl/current/t/76_magic.t Tue Apr 22 19:11:01 2008
@@ -4,7 +4,7 @@
 $^W = 1;
 
 #use Test::More "no_plan";
- use Test::More tests => 5;
+ use Test::More tests => 7;
 
 BEGIN {
     use_ok "Text::CSV_XS", ();
@@ -15,6 +15,14 @@
 
 my $foo;
 my @foo = ("#", 1..3);
+
+SKIP: {
+    $] < 5.006 and skip "Need perl 5.6.0 or higher for magic here", 2;
+    tie $foo, "Foo";
+    ok ($csv->combine (@$foo),		"combine () from magic");
+    untie $foo;
+    is_deeply ([$csv->fields], \@foo,	"column_names ()");
+    }
 
 tie $foo, "Foo";
 open  FH, ">_test.csv";

Modified: branches/upstream/libtext-csv-perl/current/t/80_diag.t
URL: http://svn.debian.org/wsvn/branches/upstream/libtext-csv-perl/current/t/80_diag.t?rev=19025&op=diff
==============================================================================
--- branches/upstream/libtext-csv-perl/current/t/80_diag.t (original)
+++ branches/upstream/libtext-csv-perl/current/t/80_diag.t Tue Apr 22 19:11:01 2008
@@ -3,7 +3,7 @@
 use strict;
 $^W = 1;
 
- use Test::More tests => 71;
+ use Test::More tests => 84;
 #use Test::More "no_plan";
 
 my %err;
@@ -23,37 +23,39 @@
 
 my $csv = Text::CSV_XS->new ();
 is (Text::CSV_XS::error_diag (), "",	"Last failure for new () - OK");
+is_deeply ([ $csv->error_diag ], [ 0, "", 0], "OK in list context");
 
-sub parse_err ($$)
+sub parse_err ($$$)
 {
-    my ($n_err, $str) = @_;
+    my ($n_err, $p_err, $str) = @_;
     my $s_err = $err{$n_err};
     my $STR = _readable ($str);
-    is ($csv->parse ($str), 0, "parse ('$STR')");
-    is ($csv->error_diag () + 0, $n_err, "Diag in numerical context");
-    is ($csv->error_diag (),     $s_err, "Diag in string context");
-    my ($c_diag, $s_diag) = $csv->error_diag ();
-    is ($c_diag, $n_err,	"Num diag in list context");
-    is ($s_diag, $s_err,	"Str diag in list context");
+    is ($csv->parse ($str), 0,	"$n_err - Err for parse ('$STR')");
+    is ($csv->error_diag () + 0, $n_err, "$n_err - Diag in numerical context");
+    is ($csv->error_diag (),     $s_err, "$n_err - Diag in string context");
+    my ($c_diag, $s_diag, $p_diag) = $csv->error_diag ();
+    is ($c_diag, $n_err,	"$n_err - Num diag in list context");
+    is ($s_diag, $s_err,	"$n_err - Str diag in list context");
+    is ($p_diag, $p_err,	"$n_err - Pos diag in list context");
     } # parse_err
 
-parse_err 2023, qq{2023,",2008-04-05,"Foo, Bar",\n}; # "
+parse_err 2023, 19, qq{2023,",2008-04-05,"Foo, Bar",\n}; # "
 
 $csv = Text::CSV_XS->new ({ escape_char => "+", eol => "\n" });
 is ($csv->error_diag (), "",		"No errors yet");
 
-parse_err 2010, qq{"x"\r};
-parse_err 2011, qq{"x"x};
+parse_err 2010,  3, qq{"x"\r};
+parse_err 2011,  3, qq{"x"x};
 
-parse_err 2021, qq{"\n"};
-parse_err 2022, qq{"\r"};
-parse_err 2025, qq{"+ "};
-parse_err 2026, qq{"\0 "};
-parse_err 2027,   '"';
-parse_err 2031, qq{\r };
-parse_err 2032, qq{ \r};
-parse_err 2034, qq{1, "bar",2};
-parse_err 2037, qq{\0 };
+parse_err 2021,  2, qq{"\n"};
+parse_err 2022,  2, qq{"\r"};
+parse_err 2025,  2, qq{"+ "};
+parse_err 2026,  2, qq{"\0 "};
+parse_err 2027,  1,   '"';
+parse_err 2031,  1, qq{\r };
+parse_err 2032,  2, qq{ \r};
+parse_err 2034,  4, qq{1, "bar",2};
+parse_err 2037,  1, qq{\0 };
 
 diag ("Next line should be an error message");
 $csv->error_diag ();




More information about the Pkg-perl-cvs-commits mailing list