File: 10handler.t

package info (click to toggle)
libdbd-odbc-perl 1.37-1
  • links: PTS, VCS
  • area: main
  • in suites: wheezy
  • size: 1,272 kB
  • sloc: perl: 7,932; ansic: 5,991; makefile: 33; sql: 8
file content (104 lines) | stat: -rwxr-xr-x 2,726 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
#!/usr/bin/perl -w -I./t
# $Id: 10handler.t 11680 2008-08-28 08:23:27Z mjevans $

use Test::More;
use strict;
$| = 1;

my $has_test_nowarnings = 1;
eval "require Test::NoWarnings";
$has_test_nowarnings = undef if $@;
my $tests = 11;
$tests += 1 if $has_test_nowarnings;
plan tests => $tests;

use_ok('ODBCTEST');
use_ok('Data::Dumper');

BEGIN {
   if (!defined $ENV{DBI_DSN}) {
      plan skip_all => "DBI_DSN is undefined";
   }
}
END {
    Test::NoWarnings::had_no_warnings()
          if ($has_test_nowarnings);
}

my $dbh = DBI->connect();
unless($dbh) {
   BAIL_OUT("Unable to connect to the database $DBI::errstr\nTests skipped.\n");
   exit 0;
}
$dbh->{PrintError} = 0;
$dbh->{RaiseError} = 1;
#
# check error handler is called, the right args are passed and the error
# is propagated if the handler returns true
#
my ($errmsg, $errstate, $errnative, $handler_called);
my $handler_return = 1;
$handler_called = 0;
sub err_handler {
    ($errstate, $errmsg, $errnative) = @_;
    $handler_called++;
    #diag "===> state: $errstate\n";
    #diag "===> msg: $errmsg\n";
    #diag "===> nativeerr: $errnative\n";
    return $handler_return;
}
$dbh->{odbc_err_handler} = \&err_handler;
my $evalret = eval {
    # this sql is supposed to be invalid
    my $sth = $dbh->prepare('select * from');
    $sth->execute;
    return 99;
};
my $eval = $@;
#diag "eval returned " . ($evalret ? $evalret : "undef") . "\n";
#diag '$@: ' . ($eval ? $eval : "undef") . "\n";
ok($handler_called >= 1, 'Error handler called');
ok($errstate, 'Error handler called - state seen');
ok($errmsg, 'Error handler called - message seen');
ok($errnative, 'Error handler called - native seen');
ok(!defined($evalret), 'Error handler called - error passed on');
ok($eval, 'Error handler called - error propagated');

#
# check we can reset the error handler (bug in 1.14 prevented this)
#
($errmsg, $errstate, $errnative, $handler_called) =
    (undef, undef, undef, 0);
$dbh->{odbc_err_handler} = undef;
$evalret = eval {
    # this sql is supposed to be invalid
    my $sth = $dbh->prepare('select * from');
    $sth->execute;
    return 99;
};
is($handler_called, 0, 'Handler cancelled');

#
# check we can filter error messages in the handler by returning 0 from
# the handler
#
($errmsg, $errstate, $errnative, $handler_called) =
    (undef, undef, undef, 0);
$dbh->{odbc_err_handler} = \&err_handler;
$handler_return = 0;

$evalret = eval {
    # this sql is supposed to be invalid
    my $sth = $dbh->prepare('select * from');
    $sth->execute if $sth;
    return 99;
};
$eval = $@;
ok(!$eval, 'Handler filtered all messages');
is($evalret, 99, 'eval complete');
$dbh->disconnect;


exit 0;
# get rid of use once warnings
print $DBI::errstr;