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