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