Commit | Line | Data |
804143de |
1 | # HARNESS-NO-PRELOAD |
dc5f035e |
2 | use strict; |
3 | use warnings; |
4 | |
221f7e77 |
5 | use Test::More tests => 13; |
a7713c3d |
6 | use Time::HiRes (); |
2f381252 |
7 | use Tree::Simple; |
dc5f035e |
8 | |
9 | my @fudge_t = ( 0, 0 ); |
10 | BEGIN { |
11 | no warnings; |
12 | *Time::HiRes::gettimeofday = sub () { return @fudge_t }; |
a7713c3d |
13 | my $original_tv_interval = \&Time::HiRes::tv_interval; |
14 | *Time::HiRes::tv_interval = sub ($;@) { |
15 | return $original_tv_interval->($_[0], $_[1] || [Time::HiRes::gettimeofday()]); |
16 | }; |
dc5f035e |
17 | } |
18 | |
19 | BEGIN { use_ok("Catalyst::Stats") }; |
20 | |
2f381252 |
21 | { |
22 | my $stats = Catalyst::Stats->new; |
23 | is (ref($stats), "Catalyst::Stats", "new"); |
dc5f035e |
24 | |
221f7e77 |
25 | is_deeply([ $stats->created ], [0, 0], "created time"); |
26 | |
2f381252 |
27 | my @expected; # level, string, time |
dc5f035e |
28 | |
2f381252 |
29 | $fudge_t[0] = 1; |
30 | ok($stats->profile("single comment arg"), "profile"); |
31 | push(@expected, [ 0, "- single comment arg", 1, 0 ]); |
dc5f035e |
32 | |
2f381252 |
33 | $fudge_t[0] = 3; |
34 | $stats->profile(comment => "hash comment arg"); |
35 | push(@expected, [ 0, "- hash comment arg", 2, 0 ]); |
dc5f035e |
36 | |
2f381252 |
37 | $fudge_t[0] = 10; |
38 | $stats->profile(begin => "block", comment => "start block"); |
39 | push(@expected, [ 0, "block - start block", 4, 1 ]); |
dc5f035e |
40 | |
dc5f035e |
41 | |
2f381252 |
42 | $fudge_t[0] = 11; |
43 | $stats->profile("inside block"); |
44 | push(@expected, [ 1, "- inside block", 1, 0 ]); |
dc5f035e |
45 | |
2f381252 |
46 | $fudge_t[1] = 100000; |
47 | my $uid = $stats->profile(begin => "nested block", uid => "boo"); |
48 | push(@expected, [ 1, "nested block", 0.7, 1 ]); |
49 | is ($uid, "boo", "set UID"); |
dc5f035e |
50 | |
2f381252 |
51 | $stats->enable(0); |
52 | $fudge_t[1] = 150000; |
53 | $stats->profile("this shouldn't appear"); |
54 | $stats->enable(1); |
dc5f035e |
55 | |
2f381252 |
56 | $fudge_t[1] = 200000; |
57 | $stats->profile(begin => "double nested block 1"); |
58 | push(@expected, [ 2, "double nested block 1", 0.2, 1 ]); |
dc5f035e |
59 | |
2f381252 |
60 | $stats->profile(comment => "attach to uid", parent => $uid); |
dc5f035e |
61 | |
2f381252 |
62 | $fudge_t[1] = 250000; |
63 | $stats->profile(begin => "badly nested block 1"); |
64 | push(@expected, [ 3, "badly nested block 1", 0.35, 1 ]); |
dc5f035e |
65 | |
2f381252 |
66 | $fudge_t[1] = 300000; |
67 | $stats->profile(comment => "interleave 1"); |
68 | push(@expected, [ 4, "- interleave 1", 0.05, 0 ]); |
dc5f035e |
69 | |
2f381252 |
70 | $fudge_t[1] = 400000; # end double nested block time |
71 | $stats->profile(end => "double nested block 1"); |
dc5f035e |
72 | |
2f381252 |
73 | $fudge_t[1] = 500000; |
74 | $stats->profile(comment => "interleave 2"); |
75 | push(@expected, [ 4, "- interleave 2", 0.2, 0 ]); |
dc5f035e |
76 | |
750d2587 |
77 | $fudge_t[1] = 550000; |
78 | $stats->profile(begin => "begin with no end"); |
79 | push(@expected, [ 4, "begin with no end", 0.05, 1 ]); |
80 | |
2f381252 |
81 | $fudge_t[1] = 600000; # end badly nested block time |
82 | $stats->profile(end => "badly nested block 1"); |
dc5f035e |
83 | |
2f381252 |
84 | $fudge_t[1] = 800000; # end nested block time |
85 | $stats->profile(end => "nested block"); |
dc5f035e |
86 | |
2f381252 |
87 | $fudge_t[0] = 14; # end block time |
88 | $fudge_t[1] = 0; |
89 | $stats->profile(end => "block", comment => "end block"); |
dc5f035e |
90 | |
2f381252 |
91 | push(@expected, [ 2, "- attach to uid", 0.1, 0 ]); |
dc5f035e |
92 | |
dc5f035e |
93 | |
2f381252 |
94 | my @report = $stats->report; |
95 | is_deeply(\@report, \@expected, "report"); |
dc5f035e |
96 | |
750d2587 |
97 | # print scalar($stats->report); |
98 | |
2f381252 |
99 | is ($stats->elapsed, 14, "elapsed"); |
100 | } |
101 | |
102 | # COMPATABILITY METHODS |
103 | |
104 | # accept |
105 | { |
106 | my $stats = Catalyst::Stats->new; |
107 | my $root = $stats->{tree}; |
108 | my $uid = $root->getUID; |
109 | |
110 | my $visitor = Tree::Simple::Visitor::FindByUID->new; |
111 | $visitor->includeTrunk(1); # needed for this test |
112 | $visitor->searchForUID($uid); |
113 | $stats->accept($visitor); |
114 | is( $visitor->getResult, $root, '[COMPAT] accept()' ); |
115 | |
116 | } |
117 | |
118 | # addChild |
119 | { |
120 | my $stats = Catalyst::Stats->new; |
121 | my $node = Tree::Simple->new( |
122 | { |
123 | action => 'test', |
124 | elapsed => '10s', |
125 | comment => "", |
126 | } |
127 | ); |
128 | |
129 | $stats->addChild( $node ); |
130 | |
131 | my $actual = $stats->{ tree }->{ _children }->[ 0 ]; |
132 | is( $actual, $node, '[COMPAT] addChild()' ); |
133 | is( $actual->getNodeValue->{ elapsed }, 10, '[COMPAT] addChild(), data munged' ); |
134 | } |
135 | |
136 | # setNodeValue |
137 | { |
138 | my $stats = Catalyst::Stats->new; |
139 | my $stat = { |
140 | action => 'test', |
141 | elapsed => '10s', |
142 | comment => "", |
143 | }; |
144 | |
145 | $stats->setNodeValue( $stat ); |
146 | |
147 | is_deeply( $stats->{tree}->getNodeValue, { action => 'test', elapsed => 10, comment => '' } , '[COMPAT] setNodeValue(), data munged' ); |
148 | } |
149 | |
150 | # getNodeValue |
151 | { |
152 | my $stats = Catalyst::Stats->new; |
153 | my $expected = $stats->{tree}->getNodeValue->{t}; |
154 | is_deeply( $stats->getNodeValue, $expected, '[COMPAT] getNodeValue()' ); |
155 | } |
156 | |
157 | # traverse |
158 | { |
159 | my $stats = Catalyst::Stats->new; |
160 | $stats->{tree}->addChild( Tree::Simple->new( { foo => 'bar' } ) ); |
161 | my @value; |
162 | $stats->traverse( sub { push @value, shift->getNodeValue->{ foo }; } ); |
163 | |
164 | is_deeply( \@value, [ 'bar' ], '[COMPAT] traverse()' ); |
165 | } |
dc5f035e |
166 | |