r12983@zaphod: kd | 2008-04-28 18:10:27 +1000
[catagits/Catalyst-Runtime.git] / t / unit_stats.t
CommitLineData
dc5f035e 1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
2f381252 6use Test::More tests => 12;
dc5f035e 7use Time::HiRes qw/gettimeofday/;
2f381252 8use Tree::Simple;
dc5f035e 9
10my @fudge_t = ( 0, 0 );
11BEGIN {
12 no warnings;
13 *Time::HiRes::gettimeofday = sub () { return @fudge_t };
14}
15
16BEGIN { 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
2f381252 72 $fudge_t[1] = 600000; # end badly nested block time
73 $stats->profile(end => "badly nested block 1");
dc5f035e 74
2f381252 75 $fudge_t[1] = 800000; # end nested block time
76 $stats->profile(end => "nested block");
dc5f035e 77
2f381252 78 $fudge_t[0] = 14; # end block time
79 $fudge_t[1] = 0;
80 $stats->profile(end => "block", comment => "end block");
dc5f035e 81
2f381252 82 push(@expected, [ 2, "- attach to uid", 0.1, 0 ]);
dc5f035e 83
dc5f035e 84
2f381252 85 my @report = $stats->report;
86 is_deeply(\@report, \@expected, "report");
dc5f035e 87
2f381252 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}
124
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