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