← Back to branch summary

~ubuntu-branches/ubuntu/edgy/libdbi-perl/edgy

« back to all changes in this revision

Viewing changes to t/09trace.t

  • Committer: Bazaar Package Importer
  • Author(s): Christian Hammers
  • Date: 2004-06-10 19:18:10 UTC
  • Revision ID: james.westby@ubuntu.com-20040610191810-me1zbh33ym9ltdi8
Tags: upstream-1.42
Import upstream version 1.42

Show diffs side-by-side

added added

removed removed

Lines of Context:
t/09trace.t
 
1
#!perl -w
 
2
# vim:sw=4:ts=8
 
3
 
 
4
use strict;
 
5
use Test::More;
 
6
use DBI;
 
7
 
 
8
BEGIN { plan tests => 65 }
 
9
 
 
10
$|=1;
 
11
 
 
12
# Connect to the example driver.
 
13
ok( my $dbh = DBI->connect('dbi:ExampleP:dummy', '', '',
 
14
                           { PrintError => 0,
 
15
                             RaiseError => 1,
 
16
                             PrintWarn => 1,
 
17
                           })
 
18
);
 
19
 
 
20
# Clean up when we're done.
 
21
END { $dbh->disconnect if $dbh };
 
22
 
 
23
 
 
24
# ------ Check the database handle attributes.
 
25
 
 
26
is( $dbh->{TraceLevel}, $DBI::dbi_debug & 0xF);
 
27
 
 
28
my $trace_file = "dbitrace.log";
 
29
print "trace to file $trace_file\n";
 
30
1 while unlink $trace_file;
 
31
$dbh->trace(0, $trace_file);
 
32
ok( -f $trace_file );
 
33
 
 
34
my @names = qw(
 
35
        SQL
 
36
        foo bar baz boo bop
 
37
);
 
38
my %flag;
 
39
my $all_flags = 0;
 
40
 
 
41
foreach my $name (@names) {
 
42
    print "parse_trace_flag $name\n";
 
43
    ok( my $flag1 = $dbh->parse_trace_flag($name) );
 
44
    ok( my $flag2 = $dbh->parse_trace_flags($name) );
 
45
    is( $flag1, $flag2 );
 
46
 
 
47
    $dbh->{TraceLevel} = $flag1;
 
48
    is( $dbh->{TraceLevel}, $flag1 );
 
49
 
 
50
    $dbh->{TraceLevel} = 0;
 
51
    is( $dbh->{TraceLevel}, 0 );
 
52
 
 
53
    $dbh->trace($flag1);
 
54
    is $dbh->trace,        $flag1;
 
55
    is $dbh->{TraceLevel}, $flag1;
 
56
 
 
57
    $dbh->{TraceLevel} = $name;         # set by name
 
58
    $dbh->{TraceLevel} = undef;         # check no change on undef
 
59
    is( $dbh->{TraceLevel}, $flag1 );
 
60
 
 
61
    $flag{$name} = $flag1;
 
62
    $all_flags |= $flag1
 
63
        if defined $flag1; # reduce noise if there's a bug
 
64
}
 
65
print "parse_trace_flag @names\n";
 
66
is keys %flag, @names;
 
67
$dbh->{TraceLevel} = 0;
 
68
$dbh->{TraceLevel} = join "|", @names;
 
69
is $dbh->{TraceLevel}, $all_flags;
 
70
 
 
71
{
 
72
print "inherit\n";
 
73
ok( my $sth = $dbh->prepare("select ctime, name from foo") );
 
74
is( $sth->{TraceLevel}, $all_flags );
 
75
}
 
76
 
 
77
$dbh->{TraceLevel} = 0;
 
78
ok !$dbh->{TraceLevel};
 
79
$dbh->{TraceLevel} = 'ALL';
 
80
ok $dbh->{TraceLevel};
 
81
 
 
82
{
 
83
print "unknown parse_trace_flag\n";
 
84
my $warn = 0;
 
85
local $SIG{__WARN__} = sub {
 
86
    if ($_[0] =~ /unknown/i) { ++$warn; print "warn: ",@_ }else{ warn @_ }
 
87
};
 
88
is $dbh->parse_trace_flag("nonesuch"), undef;
 
89
is $warn, 0;
 
90
is $dbh->parse_trace_flags("nonesuch"), 0;
 
91
is $warn, 1;
 
92
is $dbh->parse_trace_flags("nonesuch|SQL|nonesuch2"), $dbh->parse_trace_flag("SQL");
 
93
is $warn, 2;
 
94
}
 
95
 
 
96
$dbh->trace(0);
 
97
ok !$dbh->{TraceLevel};
 
98
$dbh->trace(undef, "STDERR");   # close $trace_file
 
99
ok( -s $trace_file );
 
100
 
 
101
1;
 
102
# end