More thorough testing by using PurePerl.
David Wheeler
21 years ago
| 0 | 0 | #!/usr/bin/perl -w |
| 1 | 1 | |
| 2 | # $Id: sth.t,v 1.3 2002/08/22 16:10:24 david Exp $ | |
| 2 | # $Id: sth.t,v 1.4 2002/08/23 18:26:26 david Exp $ | |
| 3 | 3 | |
| 4 | 4 | use strict; |
| 5 | 5 | use Test::More (tests => 35); |
| 6 | 6 | BEGIN { use_ok('Exception::Class::DBI') } |
| 7 | BEGIN { $ENV{DBI_PUREPERL} = 2 } | |
| 7 | 8 | use DBI; |
| 8 | 9 | |
| 9 | ||
| 10 | #ok( my $dbh = DBI->connect('dbi:ExampleP:dummy', '', '', | |
| 11 | ok( my $dbh = DBI->connect('dbi:Pg:dbname=template1', 'postgres', '', | |
| 10 | ok( my $dbh = DBI->connect('dbi:ExampleP:dummy', '', '', | |
| 11 | #ok( my $dbh = DBI->connect('dbi:Pg:dbname=template1', 'postgres', '', | |
| 12 | 12 | { PrintError => 0, |
| 13 | 13 | RaiseError => 0, |
| 14 | 14 | HandleError => Exception::Class::DBI->handler |
| 26 | 26 | $sth->execute; |
| 27 | 27 | }; |
| 28 | 28 | |
| 29 | diag "Exception: $@"; | |
| 30 | ||
| 31 | 29 | # Make sure we got the proper exception. |
| 32 | 30 | ok( my $err = $@, "Get exception" ); |
| 33 | 31 | isa_ok( $err, 'Exception::Class::DBI' ); |
| 34 | 32 | isa_ok( $err, 'Exception::Class::DBI::H' ); |
| 35 | 33 | isa_ok( $err, 'Exception::Class::DBI::STH' ); |
| 36 | 34 | |
| 37 | ok( $err->err == 7, "Check err" ); | |
| 38 | is( $err->errstr, 'ERROR: Relation "foo" does not exist', | |
| 35 | ok( $err->err == 2, "Check err" ); | |
| 36 | is( $err->errstr, 'opendir(foo): No such file or directory', | |
| 39 | 37 | "Check errstr" ); |
| 40 | is( $err->error, | |
| 41 | 'DBD::Pg::st execute failed: ERROR: Relation "foo" does not exist', | |
| 42 | "Check error" ); | |
| 38 | is( $err->error, 'DBD::ExampleP::st execute failed: opendir(foo): No such '. | |
| 39 | "file or directory\n", "Check error" ); | |
| 43 | 40 | is( $err->state, 'S1000', "Check state" ); |
| 44 | 41 | ok( ! defined $err->retval, "Check retval" ); |
| 45 | 42 | |
| 49 | 46 | ok( $err->active_kids == 0, 'Check active_kids' ); |
| 50 | 47 | ok( ! $err->compat_mode, 'Check compat_mode' ); |
| 51 | 48 | ok( ! $err->inactive_destroy, 'Check inactive_destroy' ); |
| 52 | ok( $err->trace_level == 0, 'Check trace_level' ); | |
| 49 | ||
| 50 | { | |
| 51 | # PurePerl->{TraceLevel} should return an integer, but it doesn't. | |
| 52 | local $^W; | |
| 53 | ok( $err->trace_level == 0, 'Check trace_level' ); | |
| 54 | } | |
| 55 | ||
| 53 | 56 | is( $err->fetch_hash_key_name, 'NAME', 'Check fetch_hash_key_name' ); |
| 54 | 57 | ok( ! $err->chop_blanks, 'Check chop_blanks' ); |
| 55 | 58 | ok( $err->long_read_len == 80, 'Check long_read_len' ); |
| 56 | 59 | ok( ! $err->long_trunc_ok, 'Check long_trunc_ok' ); |
| 57 | 60 | ok( ! $err->taint, 'Check taint' ); |
| 58 | ok( $err->num_of_fields == 0, 'Check num_of_fields' ); | |
| 61 | ok( $err->num_of_fields == 14, 'Check num_of_fields' ); | |
| 59 | 62 | ok( $err->num_of_params == 0, 'Check num_of_params' ); |
| 60 | 63 | is( ref $err->field_names, 'ARRAY', "Check field_names" ); |
| 61 | is( ref $err->type, 'ARRAY', "Check type" ); | |
| 62 | is( ref $err->precision, 'ARRAY', "Check precision" ); | |
| 63 | is( ref $err->scale, 'ARRAY', "Check scale" ); | |
| 64 | ||
| 65 | TODO: { | |
| 66 | # These should be array refs, but ExampleP returns undef instead. | |
| 67 | local $TODO = 'DBD::ExampleP should return references'; | |
| 68 | is( ref $err->type, 'ARRAY', "Check type" ); | |
| 69 | isa_ok( $err->precision, 'ARRAY', "Check precision" ); | |
| 70 | isa_ok( $err->scale, 'ARRAY', "Check scale" ); | |
| 71 | isa_ok( $err->param_values, 'HASH', "Check praram_values" ); | |
| 72 | } | |
| 73 | ||
| 64 | 74 | is( ref $err->nullable, 'ARRAY', "Check nullable" ); |
| 65 | 75 | ok( ! defined $err->cursor_name, "Check cursor_name" ); |
| 66 | ok( ! defined $err->param_values, "Check praram_values" ); | |
| 67 | 76 | is( $err->statement, 'select * from foo', 'Check statement' ); |
| 68 | 77 | ok( ! defined $err->rows_in_cache, "Check rows_in_cache" ); |