#!/usr/bin/perl use strict; $^W = 1; use Test::More tests => 124; #use Test::More "no_plan"; my %err; BEGIN { $ENV{PERL_TEXT_CSV} = 0; require_ok "Text::CSV"; plan skip_all => "Cannot load Text::CSV" if $@; require "t/util.pl"; open PP, "< lib/Text/CSV_PP.pm" or die "Cannot read error messages from PP\n"; while () { m/^ ([0-9]{4}) => "([^"]+)"/ and $err{$1} = $2; } } $| = 1; my $csv = Text::CSV->new (); is (Text::CSV::error_diag() . '', "", "Last failure for new () - OK"); is_deeply ([ $csv->error_diag ], [ 0, "", 0], "OK in list context"); sub parse_err ($$$) { my ($n_err, $p_err, $str) = @_; my $s_err = $err{$n_err}; my $STR = _readable ($str); 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 # a difference between PP and XS parse_err 2027, 5, qq{2023,",2008-04-05,"Foo, Bar",\n}; # " $csv = Text::CSV->new ({ escape_char => "+", eol => "\n" }); is ( "" . $csv->error_diag (), "", "No errors yet"); # error pos are different from XS parse_err 2010, 3, qq{"x"\r}; parse_err 2011, 3, qq{"x"x}; parse_err 2021, 2, qq{"\n"}; parse_err 2022, 2, qq{"\r"}; parse_err 2025, 3, qq{"+ "}; parse_err 2026, 3, qq{"\0 "}; parse_err 2027, 1, '"'; parse_err 2031, 1, qq{\r }; parse_err 2032, 2, qq{ \r}; parse_err 2034, 2, qq{1, "bar",2}; parse_err 2037, 1, qq{\0 }; { my @warn; local $SIG{__WARN__} = sub { push @warn, @_ }; $csv->error_diag (); ok (@warn == 1, "Got error message"); like ($warn[0], qr{^# CSV_PP ERROR: 2037 - EIF}, "error content"); } is (Text::CSV->new ({ ecs_char => ":" }), undef, "Unsupported option"); { my @warn; local $SIG{__WARN__} = sub { push @warn, @_ }; Text::CSV::error_diag (); ok (@warn == 1, "Error_diag in void context ::"); like ($warn[0], qr{^# CSV_PP ERROR: 1000 - INI}, "error content"); } { my @warn; local $SIG{__WARN__} = sub { push @warn, @_ }; Text::CSV->error_diag (); ok (@warn == 1, "Error_diag in void context ->"); like ($warn[0], qr{^# CSV_PP ERROR: 1000 - INI}, "error content"); } { my @warn; local $SIG{__WARN__} = sub { push @warn, @_ }; is (Text::CSV->new ({ auto_diag => 0, ecs_char => ":" }), undef, "Unsupported option"); ok (@warn == 0, "Error_diag in from new ({ auto_diag => 0})"); } { my @warn; local $SIG{__WARN__} = sub { push @warn, @_ }; is (Text::CSV->new ({ auto_diag => 1, ecs_char => ":" }), undef, "Unsupported option"); ok (@warn == 1, "Error_diag in from new ({ auto_diag => 1})"); like ($warn[0], qr{^# CSV_PP ERROR: 1000 - INI}, "error content"); } is (Text::CSV::error_diag() . '', "INI - Unknown attribute 'ecs_char'", "Last failure for new () - FAIL"); is (Text::CSV->error_diag() . '', "INI - Unknown attribute 'ecs_char'", "Last failure for new () - FAIL"); is (Text::CSV::error_diag (bless {}, "Foo") . '', "INI - 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"); ok (1, "Test auto_diag"); $csv = Text::CSV->new ({ auto_diag => 1 }); { my @warn; local $SIG{__WARN__} = sub { push @warn, @_ }; is ($csv->parse ('"","'), 0, "1 - bad parse"); ok (@warn == 1, "1 - One error"); like ($warn[0], qr '^# CSV_PP ERROR: 2027 -', "1 - error message"); } { ok ($csv->{auto_diag} = 2, "auto_diag = 2 to die"); eval { $csv->parse ('"","') }; like ($@, qr '^# CSV_PP ERROR: 2027 -', "2 - error message"); } SKIP: { skip "incompatible between PP and XS", 25; { my @warn; local $SIG{__WARN__} = sub { push @warn, @_ }; Text::CSV->new ()->_cache_diag (); ok (@warn == 1, "Got warn"); is ($warn[0], "CACHE: invalid\n", "Uninitialized cache"); } my $diag_file = "_$$.out"; open EH, ">&STDERR"; open STDERR, ">$diag_file"; ok ($csv->_cache_diag, "Cache debugging output"); close STDERR; open STDERR, ">&EH"; open EH, "<$diag_file"; is (scalar , "CACHE:\n", "Title"); while () { like ($_, qr{^ \w+\s+[0-9a-f]+:(?:".*"|\s*[0-9]+)$}, "Content"); } close EH; unlink $diag_file; } 1;