diff options
Diffstat (limited to 't/08keeperr.t')
-rw-r--r-- | t/08keeperr.t | 291 |
1 files changed, 291 insertions, 0 deletions
diff --git a/t/08keeperr.t b/t/08keeperr.t new file mode 100644 index 0000000..617a81d --- /dev/null +++ b/t/08keeperr.t @@ -0,0 +1,291 @@ +#!perl -w + +use strict; + +use Test::More tests => 79; + +## ---------------------------------------------------------------------------- +## 08keeperr.t +## ---------------------------------------------------------------------------- +# +## ---------------------------------------------------------------------------- + +BEGIN { + use_ok('DBI'); +} + +$|=1; +$^W=1; + +## ---------------------------------------------------------------------------- +# subclass DBI + +# DBI subclass +package My::DBI; +use base 'DBI'; + +# Database handle subclass +package My::DBI::db; +use base 'DBI::db'; + +# Statement handle subclass +package My::DBI::st; +use base 'DBI::st'; + +sub execute { + my $sth = shift; + # we localize an attribute here to check that the correpoding STORE + # at scope exit doesn't clear any recorded error + local $sth->{Warn} = 0; + my $rv = $sth->SUPER::execute(@_); + return $rv; +} + + +## ---------------------------------------------------------------------------- +# subclass the subclass of DBI + +package Test; + +use strict; +use base 'My::DBI'; + +use DBI; + +my @con_info = ('dbi:ExampleP:.', undef, undef, { PrintError => 0, RaiseError => 1 }); + +sub test_select { + my $dbh = shift; + eval { $dbh->selectrow_arrayref('select * from foo') }; + $dbh->disconnect; + return $@; +} + +my $err1 = test_select( My::DBI->connect(@con_info) ); +Test::More::like($err1, qr/^DBD::(ExampleP|Multiplex|Gofer)::db selectrow_arrayref failed: opendir/, '... checking error'); + +my $err2 = test_select( DBI->connect(@con_info) ); +Test::More::like($err2, qr/^DBD::(ExampleP|Multiplex|Gofer)::db selectrow_arrayref failed: opendir/, '... checking error'); + +package main; + +# test ping does not destroy the errstr +sub ping_keeps_err { + my $dbh = DBI->connect('DBI:ExampleP:', undef, undef, { PrintError => 0 }); + + $dbh->set_err(42, "ERROR 42"); + is $dbh->err, 42; + is $dbh->errstr, "ERROR 42"; + ok $dbh->ping, "ping returns true"; + is $dbh->err, 42, "err unchanged after ping"; + is $dbh->errstr, "ERROR 42", "errstr unchanged after ping"; + + $dbh->disconnect; + + $dbh->set_err(42, "ERROR 42"); + is $dbh->err, 42, "err unchanged after ping"; + is $dbh->errstr, "ERROR 42", "errstr unchanged after ping"; + ok !$dbh->ping, "ping returns false"; + # it's reasonable for ping() to set err/errstr if it fails + # so here we just test that there is an error + ok $dbh->err, "err true after failed ping"; + ok $dbh->errstr, "errstr true after failed ping"; +} + +## ---------------------------------------------------------------------------- +print "Test HandleSetErr\n"; + +my $dbh = DBI->connect(@con_info); +isa_ok($dbh, "DBI::db"); + +$dbh->{RaiseError} = 1; +$dbh->{PrintError} = 1; +$dbh->{PrintWarn} = 1; + +# warning handler +my %warn = ( failed => 0, warning => 0 ); +my @handlewarn = (0,0,0); +$SIG{__WARN__} = sub { + my $msg = shift; + if ($msg =~ /^DBD::\w+::\S+\s+(\S+)\s+(\w+)/) { + ++$warn{$2}; + $msg =~ s/\n/\\n/g; + print "warn: '$msg'\n"; + return; + } + warn $msg; +}; + +# HandleSetErr handler +$dbh->{HandleSetErr} = sub { + my ($h, $err, $errstr, $state) = @_; + return 0 + unless defined $err; + ++$handlewarn[ $err ? 2 : length($err) ]; # count [info, warn, err] calls + return 1 + if $state && $state eq "return"; # for tests + ($_[1], $_[2], $_[3]) = (99, "errstr99", "OV123") + if $state && $state eq "override"; # for tests + return 0 + if $err; # be transparent for errors + local $^W; + print "HandleSetErr called: h=$h, err=$err, errstr=$errstr, state=$state\n"; + return 0; +}; + +# start our tests + +ok(!defined $DBI::err, '... $DBI::err is not defined'); + +# ---- + +$dbh->set_err("", "(got info)"); + +ok(defined $DBI::err, '... $DBI::err is defined'); # true +is($DBI::err, "", '... $DBI::err is an empty string'); +is($DBI::errstr, "(got info)", '... $DBI::errstr is as we expected'); +is($dbh->errstr, "(got info)", '... $dbh->errstr matches $DBI::errstr'); +cmp_ok($warn{failed}, '==', 0, '... $warn{failed} is 0'); +cmp_ok($warn{warning}, '==', 0, '... $warn{warning} is 0'); +is_deeply(\@handlewarn, [ 1, 0, 0 ], '... the @handlewarn array is (1, 0, 0)'); + +# ---- + +$dbh->set_err(0, "(got warn)", "AA001"); # triggers PrintWarn + +ok(defined $DBI::err, '... $DBI::err is defined'); +is($DBI::err, "0", '... $DBI::err is "0"'); +is($DBI::errstr, "(got info)\n(got warn)", + '... $DBI::errstr is as we expected'); +is($dbh->errstr, "(got info)\n(got warn)", + '... $dbh->errstr matches $DBI::errstr'); +is($DBI::state, "AA001", '... $DBI::state is AA001'); +cmp_ok($warn{warning}, '==', 1, '... $warn{warning} is 1'); +is_deeply(\@handlewarn, [ 1, 1, 0 ], '... the @handlewarn array is (1, 1, 0)'); + + +# ---- + +$dbh->set_err("", "(got more info)"); # triggers PrintWarn + +ok(defined $DBI::err, '... $DBI::err is defined'); +is($DBI::err, "0", '... $DBI::err is "0"'); # not "", ie it's still a warn +is($dbh->err, "0", '... $dbh->err is "0"'); +is($DBI::state, "AA001", '... $DBI::state is AA001'); +is($DBI::errstr, "(got info)\n(got warn)\n(got more info)", + '... $DBI::errstr is as we expected'); +is($dbh->errstr, "(got info)\n(got warn)\n(got more info)", + '... $dbh->errstr matches $DBI::errstr'); +cmp_ok($warn{warning}, '==', 2, '... $warn{warning} is 2'); +is_deeply(\@handlewarn, [ 2, 1, 0 ], '... the @handlewarn array is (2, 1, 0)'); + + +# ---- + +$dbh->{RaiseError} = 0; +$dbh->{PrintError} = 1; + +# ---- + +$dbh->set_err("42", "(got error)", "AA002"); + +ok(defined $DBI::err, '... $DBI::err is defined'); +cmp_ok($DBI::err, '==', 42, '... $DBI::err is 42'); +cmp_ok($warn{warning}, '==', 2, '... $warn{warning} is 2'); +is($dbh->errstr, "(got info)\n(got warn)\n(got more info) [state was AA001 now AA002]\n(got error)", + '... $dbh->errstr is as we expected'); +is($DBI::state, "AA002", '... $DBI::state is AA002'); +is_deeply(\@handlewarn, [ 2, 1, 1 ], '... the @handlewarn array is (2, 1, 1)'); + +# ---- + +$dbh->set_err("", "(got info)"); + +ok(defined $DBI::err, '... $DBI::err is defined'); +cmp_ok($DBI::err, '==', 42, '... $DBI::err is 42'); +cmp_ok($warn{warning}, '==', 2, '... $warn{warning} is 2'); +is($dbh->errstr, "(got info)\n(got warn)\n(got more info) [state was AA001 now AA002]\n(got error)\n(got info)", + '... $dbh->errstr is as we expected'); +is_deeply(\@handlewarn, [ 3, 1, 1 ], '... the @handlewarn array is (3, 1, 1)'); + +# ---- + +$dbh->set_err("0", "(got warn)"); # no PrintWarn because it's already an err + +ok(defined $DBI::err, '... $DBI::err is defined'); +cmp_ok($DBI::err, '==', 42, '... $DBI::err is 42'); +cmp_ok($warn{warning}, '==', 2, '... $warn{warning} is 2'); +is($dbh->errstr, "(got info)\n(got warn)\n(got more info) [state was AA001 now AA002]\n(got error)\n(got info)\n(got warn)", + '... $dbh->errstr is as we expected'); +is_deeply(\@handlewarn, [ 3, 2, 1 ], '... the @handlewarn array is (3, 2, 1)'); + +# ---- + +$dbh->set_err("4200", "(got new error)", "AA003"); + +ok(defined $DBI::err, '... $DBI::err is defined'); +cmp_ok($DBI::err, '==', 4200, '... $DBI::err is 4200'); +cmp_ok($warn{warning}, '==', 2, '... $warn{warning} is 2'); +is($dbh->errstr, "(got info)\n(got warn)\n(got more info) [state was AA001 now AA002]\n(got error)\n(got info)\n(got warn) [err was 42 now 4200] [state was AA002 now AA003]\n(got new error)", + '... $dbh->errstr is as we expected'); +is_deeply(\@handlewarn, [ 3, 2, 2 ], '... the @handlewarn array is (3, 2, 2)'); + +# ---- + +$dbh->set_err(undef, "foo", "bar"); # clear error + +ok(!defined $dbh->errstr, '... $dbh->errstr is defined'); +ok(!defined $dbh->err, '... $dbh->err is defined'); +is($dbh->state, "", '... $dbh->state is an empty string'); + +# ---- + +%warn = ( failed => 0, warning => 0 ); +@handlewarn = (0,0,0); + +# ---- + +my @ret; +@ret = $dbh->set_err(1, "foo"); # PrintError + +cmp_ok(scalar(@ret), '==', 1, '... only returned one value'); +ok(!defined $ret[0], '... the first value is undefined'); +ok(!defined $dbh->set_err(2, "bar"), '... $dbh->set_err returned undefiend'); # PrintError +ok(!defined $dbh->set_err(3, "baz"), '... $dbh->set_err returned undefiend'); # PrintError +ok(!defined $dbh->set_err(0, "warn"), '... $dbh->set_err returned undefiend'); # PrintError +is($dbh->errstr, "foo [err was 1 now 2]\nbar [err was 2 now 3]\nbaz\nwarn", + '... $dbh->errstr is as we expected'); +is($warn{failed}, 4, '... $warn{failed} is 4'); +is_deeply(\@handlewarn, [ 0, 1, 3 ], '... the @handlewarn array is (0, 1, 3)'); + +# ---- + +$dbh->set_err(undef, undef, undef); # clear error + +@ret = $dbh->set_err(1, "foo", "AA123", "method"); +cmp_ok(scalar @ret, '==', 1, '... only returned one value'); +ok(!defined $ret[0], '... the first value is undefined'); + +@ret = $dbh->set_err(1, "foo", "AA123", "method", "42"); +cmp_ok(scalar @ret, '==', 1, '... only returned one value'); +is($ret[0], "42", '... the first value is "42"'); + +@ret = $dbh->set_err(1, "foo", "return"); +cmp_ok(scalar @ret, '==', 0, '... returned no values'); + +# ---- + +$dbh->set_err(undef, undef, undef); # clear error + +@ret = $dbh->set_err("", "info", "override"); +cmp_ok(scalar @ret, '==', 1, '... only returned one value'); +ok(!defined $ret[0], '... the first value is undefined'); +cmp_ok($dbh->err, '==', 99, '... $dbh->err is 99'); +is($dbh->errstr, "errstr99", '... $dbh->errstr is as we expected'); +is($dbh->state, "OV123", '... $dbh->state is as we expected'); +$dbh->disconnect; + +ping_keeps_err(); + +1; +# end |