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