r24815 - in /trunk/libtext-csv-xs-perl: CSV_XS.pm CSV_XS.xs ChangeLog META.yml Makefile.PL README debian/changelog examples/csv-check t/45_eol.t t/65_allow.t t/70_rt.t t/80_diag.t

dmn at users.alioth.debian.org dmn at users.alioth.debian.org
Sat Sep 6 05:25:12 UTC 2008


Author: dmn
Date: Sat Sep  6 05:25:09 2008
New Revision: 24815

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=24815
Log:
New upstream release

Modified:
    trunk/libtext-csv-xs-perl/CSV_XS.pm
    trunk/libtext-csv-xs-perl/CSV_XS.xs
    trunk/libtext-csv-xs-perl/ChangeLog
    trunk/libtext-csv-xs-perl/META.yml
    trunk/libtext-csv-xs-perl/Makefile.PL
    trunk/libtext-csv-xs-perl/README
    trunk/libtext-csv-xs-perl/debian/changelog
    trunk/libtext-csv-xs-perl/examples/csv-check
    trunk/libtext-csv-xs-perl/t/45_eol.t
    trunk/libtext-csv-xs-perl/t/65_allow.t
    trunk/libtext-csv-xs-perl/t/70_rt.t
    trunk/libtext-csv-xs-perl/t/80_diag.t

Modified: trunk/libtext-csv-xs-perl/CSV_XS.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtext-csv-xs-perl/CSV_XS.pm?rev=24815&op=diff
==============================================================================
--- trunk/libtext-csv-xs-perl/CSV_XS.pm (original)
+++ trunk/libtext-csv-xs-perl/CSV_XS.pm Sat Sep  6 05:25:09 2008
@@ -30,7 +30,7 @@
 use Carp;
 
 use vars   qw( $VERSION @ISA );
-$VERSION = "0.52";
+$VERSION = "0.54";
 @ISA     = qw( DynaLoader );
 
 sub PV { 0 }
@@ -94,6 +94,7 @@
 	}
     $last_new_err = "";
     my $self  = {%def_attr, %{$attr}};
+    defined $\ and $self->{eol} = $\;
     bless $self, $class;
     defined $self->{types} and $self->types ($self->{types});
     $self;
@@ -1182,25 +1183,6 @@
 
 =head1 EXAMPLES
 
-An example for creating CSV files:
-
-  my $csv = Text::CSV_XS->new;
-
-  open my $csv_fh, ">", "hello.csv" or die "hello.csv: $!";
-
-  my @sample_input_fields = (
-      'You said, "Hello!"',   5.67,
-      '"Surely"',   '',   '3.14159');
-  if ($csv->combine (@sample_input_fields)) {
-      my $string = $csv->string;
-      print $csv_fh "$string\n";
-      }
-  else {
-      my $err = $csv->error_input;
-      print "combine () failed on argument: ", $err, "\n";
-      }
-  close $csv_fh or die "hello.csv: $!";
-
 An example for parsing CSV strings:
 
   my $csv = Text::CSV_XS->new ({ keep_meta_info => 1, binary => 1 });
@@ -1220,7 +1202,27 @@
       $csv->error_diag ();
       }
 
-Dumping the content of a database ($dbh) table ($tbl) to CSV:
+An example for creating CSV files:
+
+  my $csv = Text::CSV_XS->new;
+
+  open my $csv_fh, ">", "hello.csv" or die "hello.csv: $!";
+
+  my @sample_input_fields = (
+      'You said, "Hello!"',   5.67,
+      '"Surely"',   '',   '3.14159');
+  if ($csv->combine (@sample_input_fields)) {
+      my $string = $csv->string;
+      print $csv_fh "$string\n";
+      }
+  else {
+      my $err = $csv->error_input;
+      print "combine () failed on argument: ", $err, "\n";
+      }
+  close $csv_fh or die "hello.csv: $!";
+
+Or using the C<print ()> method, which is fater like in
+dumping the content of a database ($dbh) table ($tbl) to CSV:
 
   my $csv = Text::CSV_XS->new ({ binary => 1, eol => $/ });
   open my $fh, ">", "$tbl.csv" or die "$tbl.csv: $!";
@@ -1441,19 +1443,34 @@
 Sequences like C<1,"foo\rbar",2> are only allowed when the binary option
 has been selected with the constructor.
 
-=item 2023 "EIQ - QUO ..."
+=item 2023 "EIQ - QUO character not allowed
 
 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"
 
+The escape character is not allowed as last character in an input stream.
+
 =item 2025 "EIQ - Loose unescaped escape"
 
+An escape character should escape only characters that need escaping. Allowing
+the escape for other characters is possible with the C<allow_loose_escape>
+attribute.
+
 =item 2026 "EIQ - Binary character inside quoted field, binary off"
 
+Binary characters are not allowed by default. Exceptions are fields that
+contain valid UTF-8, that will automatically be upgraded is the content is
+valid UTF-8. Pass the C<binary> attribute with a true value to accept binary
+characters.
+
 =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
+exhausted before the quote is found, that field is not terminated.
+
 =item 2030 "EIF - NL char inside unquoted verbatim, binary off"
 
 =item 2031 "EIF - CR char is first char of field, not part of EOL"
@@ -1469,6 +1486,8 @@
 =item 2037 "EIF - Binary character in unquoted field, binary off"
 
 =item 2110 "ECB - Binary character in Combine, binary off"
+
+=item 2200 "EIO - print to IO failed. See errno"
 
 =item 3001 "EHR - Unsupported syntax for column_names ()"
 

Modified: trunk/libtext-csv-xs-perl/CSV_XS.xs
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtext-csv-xs-perl/CSV_XS.xs?rev=24815&op=diff
==============================================================================
--- trunk/libtext-csv-xs-perl/CSV_XS.xs (original)
+++ trunk/libtext-csv-xs-perl/CSV_XS.xs Sat Sep  6 05:25:09 2008
@@ -151,6 +151,9 @@
     /* Combine errors */
     { 2110, "ECB - Binary character in Combine, binary off"			},
 
+    /* IO errors */
+    { 2200, "EIO - print to IO failed. See errno"				},
+
     /* Hash-Ref errors */
     { 3001, "EHR - Unsupported syntax for column_names ()"			},
     { 3002, "EHR - getline_hr () called before column_names ()"			},
@@ -181,14 +184,14 @@
 
     while (xs_errors[i].xs_errno && xs_errors[i].xs_errno != xse) i++;
     if ((err = newSVpv (xs_errors[i].xs_errstr, 0))) {
-	sv_upgrade (err, SVt_PVIV);
-	SvIV_set (err, xse);
-	SvIOK_on (err);
-	hv_store (csv->self, "_ERROR_DIAG",  11, err,           0);
+	SvUPGRADE (err, SVt_PVIV);
+	SvIV_set  (err, xse);
+	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);
-	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 */
@@ -357,8 +360,11 @@
 	PUTBACK;
 	result = call_method ("print", G_SCALAR);
 	SPAGAIN;
-	if (result)
+	if (result) {
 	    result = POPi;
+	    unless (result)
+		SetDiag (csv, 2200);
+	    }
 	PUTBACK;
 	SvREFCNT_dec (tmp);
 	}
@@ -373,8 +379,10 @@
     } /* Print */
 
 #define CSV_PUT(csv,dst,c) {				\
-    if ((csv)->used == sizeof ((csv)->buffer) - 1)	\
-        Print ((csv), (dst));				\
+    if ((csv)->used == sizeof ((csv)->buffer) - 1) {	\
+        unless (Print ((csv), (dst)))			\
+	    return FALSE;				\
+        }						\
     (csv)->buffer[(csv)->used++] = (c);			\
     }
 
@@ -444,10 +452,10 @@
 			return FALSE;
 			}
 		    }
-		if (csv->quote_char  && c == csv->quote_char)
+		if (c == csv->quote_char  && csv->quote_char)
 		    e = 1;
 		else
-		if (csv->escape_char && c == csv->escape_char)
+		if (c == csv->escape_char && csv->escape_char)
 		    e = 1;
 		else
 		if (c == (char)0) {
@@ -470,7 +478,7 @@
 	    CSV_PUT (csv, dst, *ptr++);
 	}
     if (csv->used)
-	Print (csv, dst);
+	return Print (csv, dst);
     return TRUE;
     } /* Combine */
 
@@ -799,7 +807,7 @@
 		}
 	    } /* CH_CR */
 	else
-	if (csv->quote_char && c == csv->quote_char) {
+	if (c == csv->quote_char && csv->quote_char) {
 #if MAINT_DEBUG > 1
 	    fprintf (stderr, "# %d/%d/%02x pos %d = QUO '%c'\n",
 		waitingForField ? 1 : 0, sv ? 1 : 0, f, spl, c);
@@ -818,8 +826,8 @@
 
 #if ALLOW_ALLOW
 		    if (csv->allow_whitespace) {
-/* uncovered */		while (c2 == CH_SPACE || c2 == CH_TAB) {
-/* uncovered */		    c2 = CSV_GET;
+			while (c2 == CH_SPACE || c2 == CH_TAB) {
+			    c2 = CSV_GET;
 			    }
 			}
 #endif
@@ -839,13 +847,13 @@
 
 			if (csv->eol_is_cr) {
 			    AV_PUSH;
-/* uncovered */		    return TRUE;
+			    return TRUE;
 			    }
 
 			c3 = CSV_GET;
 			if (c3 == CH_NL) {
 			    AV_PUSH;
-/* uncovered */		    return TRUE;
+			    return TRUE;
 			    }
 
 			ParseError (csv, 2010, csv->used - 2);
@@ -914,20 +922,11 @@
 			    }
 			}
 
+#if ALLOW_ALLOW
 		    if (csv->allow_loose_quotes && csv->escape_char != csv->quote_char) {
 			CSV_PUT_SV (c);
 			c = c2;
-			goto restart;
-			}
-#if ALLOW_ALLOW
-		    if (csv->allow_whitespace) {
-			while (c2 == CH_SPACE || c2 == CH_TAB) {
-/* uncovered */		    c2 = CSV_GET;
-			    }
-			if (c2 == csv->sep_char || c2 == EOF) {
-/* uncovered */		    c = c2;
-/* uncovered */		    goto restart;
-			    }
+/* uncovered */		goto restart;
 			}
 #endif
 
@@ -947,7 +946,7 @@
 		ERROR_INSIDE_FIELD (2034);
 	    } /* QUO char */
 	else
-	if (csv->escape_char && c == csv->escape_char) {
+	if (c == csv->escape_char && csv->escape_char) {
 #if MAINT_DEBUG > 1
 	    fprintf (stderr, "# %d/%d/%02x pos %d = ESC '%c'\n",
 		waitingForField ? 1 : 0, sv ? 1 : 0, f, spl, c);
@@ -1031,7 +1030,7 @@
 
 	/* continue */
 #if ALLOW_ALLOW
-	if (csv->useIO && csv->verbatim && csv->used == csv->size)
+	if (csv->verbatim && csv->useIO && csv->used == csv->size)
 	    break;
 #endif
 	}

Modified: trunk/libtext-csv-xs-perl/ChangeLog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtext-csv-xs-perl/ChangeLog?rev=24815&op=diff
==============================================================================
--- trunk/libtext-csv-xs-perl/ChangeLog (original)
+++ trunk/libtext-csv-xs-perl/ChangeLog Sat Sep  6 05:25:09 2008
@@ -1,3 +1,17 @@
+2008-09-04 0.54 - H.Merijn Brand   <h.m.brand at xs4all.nl>
+
+	* IO failure in print () was not propagated (ilmari, RT#38960)
+
+2008-09-01 0.53 - H.Merijn Brand   <h.m.brand at xs4all.nl>
+
+	* SvUPGRADE is a safer choice than sv_upgrade (Lubomir Rintel, RT#38890)
+	* bring docs in sync with reality for msg 2023
+	* Default eol for print is $\
+	* examples/csv-check should default to CSV , not to ;
+	* Tests for SetDiag (0)
+	* Tests for error 2030
+	* Code cleanup (Devel::Cover++)
+
 2008-06-28  0.52 - H.Merijn Brand   <h.m.brand at xs4all.nl>
 
 	* Using undef for hash keys is a bad plan

Modified: trunk/libtext-csv-xs-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtext-csv-xs-perl/META.yml?rev=24815&op=diff
==============================================================================
--- trunk/libtext-csv-xs-perl/META.yml (original)
+++ trunk/libtext-csv-xs-perl/META.yml Sat Sep  6 05:25:09 2008
@@ -1,6 +1,6 @@
---- #YAML:1.0
+--- #YAML:1.4
 name:              Text-CSV_XS
-version:           0.52
+version:           0.54
 abstract:          Comma-Separated Values manipulation routines
 license:           perl
 author:              
@@ -10,7 +10,7 @@
 provides:
     Text::CSV_XS:
         file:      CSV_XS.pm
-        version:   0.52
+        version:   0.54
 requires:     
     perl:          5.005
     DynaLoader:    0
@@ -24,5 +24,5 @@
 resources:
     license:       http://dev.perl.org/licenses/
 meta-spec:
-    url:           http://module-build.sourceforge.net/META-spec-v1.3.html
-    version:       1.3
+    version:       1.4
+    url:           http://module-build.sourceforge.net/META-spec-v1.4.html

Modified: trunk/libtext-csv-xs-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtext-csv-xs-perl/Makefile.PL?rev=24815&op=diff
==============================================================================
--- trunk/libtext-csv-xs-perl/Makefile.PL (original)
+++ trunk/libtext-csv-xs-perl/Makefile.PL Sat Sep  6 05:25:09 2008
@@ -73,12 +73,8 @@
 	: "";
     join "\n" =>
 	'cover test_cover:',
-	'	cover -delete',
-	'	make',
-	'	HARNESS_PERL_SWITCHES=-MDevel::Cover $(MAKE) test',
-	'	gcov CSV_XS.c 2>/dev/null',
-	'	find * -name \*.gcov -exec gcov2perl {} \;',
-	'	cover',
+	'	ccache -C',
+	'	cover -test',
 	'',
 	'leakcheck:',
 	"	$valgrind",
@@ -87,10 +83,13 @@
 	'leaktest:',
 	q{	sandbox/leaktest $(FULLPERLRUN) "test_harness($(TEST_VERBOSE), '$(INST_LIB)', '$(INST_ARCHLIB)')" $(TEST_FILES)},
 	'',
+	'checkmeta:',
+	'	perl sandbox/genMETA.pl -c',
+	'',
 	'fixmeta:	distmeta',
 	'	perl sandbox/genMETA.pl',
 	'',
-	'tgzdist:	fixmeta $(DISTVNAME).tar.gz distcheck',
+	'tgzdist:	checkmeta fixmeta $(DISTVNAME).tar.gz distcheck',
 	'	- at mv -f $(DISTVNAME).tar.gz $(DISTVNAME).tgz',
 	'	- at cpants_lint.pl $(DISTVNAME).tgz',
 	'',

Modified: trunk/libtext-csv-xs-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtext-csv-xs-perl/README?rev=24815&op=diff
==============================================================================
--- trunk/libtext-csv-xs-perl/README (original)
+++ trunk/libtext-csv-xs-perl/README Sat Sep  6 05:25:09 2008
@@ -15,10 +15,11 @@
     it under the same terms as Perl itself.
 
     Recent changes can be (re)viewed in the public GIT repository at
-    git://repo.or.cz/Text-CSV_XS.git
+    http://repo.or.cz/w/Text-CSV_XS.git
 
 Prerequisites:
-    perl 5.005. 5.005 will not be able to build the manual pages.
+    perl 5.005_03. 5.005 will not be able to build the manual pages.
+    examples require 5.006, but are probably easy to mold into 5.005
 
 Build/Installation:
     Standard build/installation:
@@ -26,7 +27,7 @@
 	make
 	make test
 	make install
-    (The 'make' step cannot be ommitted for perl-5.005)
+    (The 'make' step cannot be omitted for perl-5.005)
 
 Author:
     H.Merijn Brand <h.m.brand at xs4all.nl>

Modified: trunk/libtext-csv-xs-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtext-csv-xs-perl/debian/changelog?rev=24815&op=diff
==============================================================================
--- trunk/libtext-csv-xs-perl/debian/changelog (original)
+++ trunk/libtext-csv-xs-perl/debian/changelog Sat Sep  6 05:25:09 2008
@@ -1,3 +1,9 @@
+libtext-csv-xs-perl (0.54-1) UNRELEASED; urgency=low
+
+  * New upstream release
+
+ -- Damyan Ivanov <dmn at debian.org>  Sat, 06 Sep 2008 08:22:12 +0300
+
 libtext-csv-xs-perl (0.52-1) unstable; urgency=low
 
   * New upstream release.

Modified: trunk/libtext-csv-xs-perl/examples/csv-check
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtext-csv-xs-perl/examples/csv-check?rev=24815&op=diff
==============================================================================
--- trunk/libtext-csv-xs-perl/examples/csv-check (original)
+++ trunk/libtext-csv-xs-perl/examples/csv-check Sat Sep  6 05:25:09 2008
@@ -3,14 +3,14 @@
 use strict;
 use warnings;
 
-our $VERSION = "1.1";	# 2008-04-17
+our $VERSION = "1.2";	# 2008-08-10
 
 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 = ';'
+       -s <sep>   use <sep>   as seperator char. Auto-detect, default = ','
        -q <quot>  use <quot>  as quotation char. Default = '"'
 EOU
     exit $err;
@@ -38,17 +38,14 @@
 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" :
+	$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.
+	       m/\w,[\w,]/     ? ","  :
+	       m/\w;[\w;]/     ? ";"  :
+	       m/\w\t[\w]/     ? "\t" :
+				 ","  ;
 	$firstline = $_;
 	$rows++;
 	last;

Modified: trunk/libtext-csv-xs-perl/t/45_eol.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtext-csv-xs-perl/t/45_eol.t?rev=24815&op=diff
==============================================================================
--- trunk/libtext-csv-xs-perl/t/45_eol.t (original)
+++ trunk/libtext-csv-xs-perl/t/45_eol.t Sat Sep  6 05:25:09 2008
@@ -3,7 +3,7 @@
 use strict;
 $^W = 1;
 
-use Test::More tests => 128;
+use Test::More tests => 133;
 
 BEGIN {
     require_ok "Text::CSV_XS";
@@ -68,6 +68,17 @@
     unlink "_eol.csv";
     }
 
+{   my $csv = Text::CSV_XS->new ({ escape_char => undef });
+
+    ok ($csv->parse (qq{"x"\r\n}), "Trailing \\r\\n with no escape char");
+
+    is ($csv->eol ("\r"), "\r", "eol set to \\r");
+    ok ($csv->parse (qq{"x"\r}),   "Trailing \\r with no escape char");
+
+    ok ($csv->allow_whitespace (1), "Allow whitespace");
+    ok ($csv->parse (qq{"x" \r}),  "Trailing \\r with no escape char");
+    }
+
 ok (1, "Specific \\r test from tfrayner");
 {   $/ = "\r";
     open  FH, ">_eol.csv";

Modified: trunk/libtext-csv-xs-perl/t/65_allow.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtext-csv-xs-perl/t/65_allow.t?rev=24815&op=diff
==============================================================================
--- trunk/libtext-csv-xs-perl/t/65_allow.t (original)
+++ trunk/libtext-csv-xs-perl/t/65_allow.t Sat Sep  6 05:25:09 2008
@@ -4,7 +4,7 @@
 $^W = 1;
 
 #use Test::More "no_plan";
- use Test::More tests => 829;
+ use Test::More tests => 838;
 
 BEGIN {
     use_ok "Text::CSV_XS", ();
@@ -312,6 +312,20 @@
     is ($row->[2], "*\r\n",			"#\\r\\n $gc fld 2");
 
     close FH;
+
+    $csv = Text::CSV_XS->new ({
+	binary		=> 0,
+	verbatim	=> 1,
+	eol		=> "#\r\n",
+	});
+    open  FH, ">_test.csv";
+    print FH $str[1];
+    close FH;
+    open  FH, "<_test.csv";
+    is ($csv->getline (*FH), undef,	"#\\r\\n $gc getline 2030");
+    is (0 + $csv->error_diag (), 2030,	"Got 2030");
+    close FH;
+
     unlink "_test.csv";
     }
 
@@ -346,3 +360,18 @@
     close FH;
     unlink "_test.csv";
     }
+
+{   my $csv = Text::CSV_XS->new ({});
+
+    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");
+    }

Modified: trunk/libtext-csv-xs-perl/t/70_rt.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtext-csv-xs-perl/t/70_rt.t?rev=24815&op=diff
==============================================================================
--- trunk/libtext-csv-xs-perl/t/70_rt.t (original)
+++ trunk/libtext-csv-xs-perl/t/70_rt.t Sat Sep  6 05:25:09 2008
@@ -4,12 +4,15 @@
 $^W = 1;
 
 #use Test::More "no_plan";
- use Test::More tests => 69;
+ use Test::More tests => 73;
 
 BEGIN {
     use_ok "Text::CSV_XS", ();
     plan skip_all => "Cannot load Text::CSV_XS" if $@;
     }
+
+my $csv_file = "_test.csv";
+END { unlink $csv_file }
 
 my $rt_no;
 my %input;
@@ -41,11 +44,11 @@
 {   # http://rt.cpan.org/Ticket/Display.html?id=21530
     # 21530: getline () does not return documented value at end of filehandle
     # IO::Handle  was first released with perl 5.00307
-    open  FH, ">_test.csv";
+    open  FH, ">$csv_file";
     print FH @{$input{21530}};
     close FH;
     ok (my $csv = Text::CSV_XS->new ({ binary => 1 }), "RT-21530: getline () return at eof");
-    open  FH, "<_test.csv";
+    open  FH, "<$csv_file";
     my $row;
     foreach my $line (1 .. 5) {
 	ok ($row = $csv->getline (*FH), "getline $line");
@@ -55,7 +58,7 @@
     ok (eof FH, "EOF");
     is ($row = $csv->getline (*FH), undef, "getline EOF");
     close FH;
-    unlink "_test.csv";
+    unlink $csv_file;
     }
 
 {   # http://rt.cpan.org/Ticket/Display.html?id=21530
@@ -92,12 +95,12 @@
 
 {   # http://rt.cpan.org/Ticket/Display.html?id=34474
     # 34474: wish: integrate row-as-hashref feature from Parse::CSV
-    open  FH, ">_test.csv";
+    open  FH, ">$csv_file";
     print FH @{$input{34474}};
     close FH;
     ok (my $csv = Text::CSV_XS->new (),		"RT-34474: getline_hr ()");
     is ($csv->column_names, undef,		"No headers yet");
-    open  FH, "<_test.csv";
+    open  FH, "<$csv_file";
     my $row;
     ok ($row = $csv->getline (*FH),		"getline headers");
     is ($row->[0], "code",			"Header line");
@@ -110,7 +113,24 @@
 	like ($hr->{name}, qr/^[A-Z][a-z]+$/,	"Name");
 	}
     close FH;
-    unlink "_test.csv";
+    unlink $csv_file;
+    }
+
+{   # http://rt.cpan.org/Ticket/Display.html?id=38960
+    # 38960: print () on invalid filehandle warns and returns success
+    open  FH, ">$csv_file";
+    print FH "";
+    close FH;
+    my $err = "";
+    open  FH, "<$csv_file";
+    ok (my $csv = Text::CSV_XS->new (),		"RT-38960: print () fails");
+    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");
+    close FH;
+    unlink $csv_file;
     }
 
 __END__

Modified: trunk/libtext-csv-xs-perl/t/80_diag.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtext-csv-xs-perl/t/80_diag.t?rev=24815&op=diff
==============================================================================
--- trunk/libtext-csv-xs-perl/t/80_diag.t (original)
+++ trunk/libtext-csv-xs-perl/t/80_diag.t Sat Sep  6 05:25:09 2008
@@ -3,7 +3,7 @@
 use strict;
 $^W = 1;
 
- use Test::More tests => 84;
+ use Test::More tests => 86;
 #use Test::More "no_plan";
 
 my %err;
@@ -70,6 +70,9 @@
 					"Last failure for new () - FAIL");
 is (Text::CSV_XS::error_diag (bless {}, "Foo"), "Unknown attribute 'ecs_char'",
 					"Last failure for new () - FAIL");
+$csv->SetDiag (0);
+is (0 + $csv->error_diag (), 0,  "Reset error NUM");
+is (    $csv->error_diag (), "", "Reset error NUM");
 
 package Text::CSV_XS::Subclass;
 




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