failing (crashing, really) test for this strange pg thing. could not figure out...
[dbsrgits/DBIx-Class.git] / t / 31stats.t
1 #!/usr/bin/perl
2
3 use strict;
4 use warnings;
5 use Test::More;
6
7 plan tests => 12;
8
9 use lib qw(t/lib);
10
11 use_ok('DBICTest');
12 my $schema = DBICTest->init_schema();
13
14 my $cbworks = 0;
15
16 $schema->storage->debugcb(sub { $cbworks = 1; });
17 $schema->storage->debug(0);
18 my $rs = $schema->resultset('CD')->search({});
19 $rs->count();
20 ok(!$cbworks, 'Callback not called with debug disabled');
21
22 $schema->storage->debug(1);
23
24 $rs->count();
25 ok($cbworks, 'Debug callback worked.');
26
27 my $prof = new DBIx::Test::Profiler();
28 $schema->storage->debugobj($prof);
29
30 # Test non-transaction calls.
31 $rs->count();
32 ok($prof->{'query_start'}, 'query_start called');
33 ok($prof->{'query_end'}, 'query_end called');
34 ok(!$prof->{'txn_begin'}, 'txn_begin not called');
35 ok(!$prof->{'txn_commit'}, 'txn_commit not called');
36
37 $prof->reset();
38
39 # Test transaction calls
40 $schema->txn_begin();
41 ok($prof->{'txn_begin'}, 'txn_begin called');
42
43 $rs = $schema->resultset('CD')->search({});
44 $rs->count();
45 ok($prof->{'query_start'}, 'query_start called');
46 ok($prof->{'query_end'}, 'query_end called');
47
48 $schema->txn_commit();
49 ok($prof->{'txn_commit'}, 'txn_commit called');
50
51 $prof->reset();
52
53 # Test a rollback
54 $schema->txn_begin();
55 $rs = $schema->resultset('CD')->search({});
56 $rs->count();
57 $schema->txn_rollback();
58 ok($prof->{'txn_rollback'}, 'txn_rollback called');
59
60 $schema->storage->debug(0);
61
62 package DBIx::Test::Profiler;
63 use strict;
64
65 sub new {
66     my $self = bless({});
67 }
68
69 sub query_start {
70     my $self = shift();
71     $self->{'query_start'} = 1;
72 }
73
74 sub query_end {
75     my $self = shift();
76     $self->{'query_end'} = 1;
77 }
78
79 sub txn_begin {
80     my $self = shift();
81     $self->{'txn_begin'} = 1;
82 }
83
84 sub txn_rollback {
85     my $self = shift();
86     $self->{'txn_rollback'} = 1;
87 }
88
89 sub txn_commit {
90     my $self = shift();
91     $self->{'txn_commit'} = 1;
92 }
93
94 sub reset {
95     my $self = shift();
96
97     $self->{'query_start'} = 0;
98     $self->{'query_end'} = 0;
99     $self->{'txn_begin'} = 0;
100     $self->{'txn_rollback'} = 0;
101     $self->{'txn_end'} = 0;
102 }
103
104 1;