5 use Test::More tests => 13;
9 my @fudge_t = ( 0, 0 );
12 *Time::HiRes::gettimeofday = sub () { return @fudge_t };
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()]);
19 BEGIN { use_ok("Catalyst::Stats") };
22 my $stats = Catalyst::Stats->new;
23 is (ref($stats), "Catalyst::Stats", "new");
25 is_deeply([ $stats->created ], [0, 0], "created time");
27 my @expected; # level, string, time
30 ok($stats->profile("single comment arg"), "profile");
31 push(@expected, [ 0, "- single comment arg", 1, 0 ]);
34 $stats->profile(comment => "hash comment arg");
35 push(@expected, [ 0, "- hash comment arg", 2, 0 ]);
38 $stats->profile(begin => "block", comment => "start block");
39 push(@expected, [ 0, "block - start block", 4, 1 ]);
43 $stats->profile("inside block");
44 push(@expected, [ 1, "- inside block", 1, 0 ]);
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");
53 $stats->profile("this shouldn't appear");
57 $stats->profile(begin => "double nested block 1");
58 push(@expected, [ 2, "double nested block 1", 0.2, 1 ]);
60 $stats->profile(comment => "attach to uid", parent => $uid);
63 $stats->profile(begin => "badly nested block 1");
64 push(@expected, [ 3, "badly nested block 1", 0.35, 1 ]);
67 $stats->profile(comment => "interleave 1");
68 push(@expected, [ 4, "- interleave 1", 0.05, 0 ]);
70 $fudge_t[1] = 400000; # end double nested block time
71 $stats->profile(end => "double nested block 1");
74 $stats->profile(comment => "interleave 2");
75 push(@expected, [ 4, "- interleave 2", 0.2, 0 ]);
78 $stats->profile(begin => "begin with no end");
79 push(@expected, [ 4, "begin with no end", 0.05, 1 ]);
81 $fudge_t[1] = 600000; # end badly nested block time
82 $stats->profile(end => "badly nested block 1");
84 $fudge_t[1] = 800000; # end nested block time
85 $stats->profile(end => "nested block");
87 $fudge_t[0] = 14; # end block time
89 $stats->profile(end => "block", comment => "end block");
91 push(@expected, [ 2, "- attach to uid", 0.1, 0 ]);
94 my @report = $stats->report;
95 is_deeply(\@report, \@expected, "report");
97 # print scalar($stats->report);
99 is ($stats->elapsed, 14, "elapsed");
102 # COMPATABILITY METHODS
106 my $stats = Catalyst::Stats->new;
107 my $root = $stats->{tree};
108 my $uid = $root->getUID;
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()' );
120 my $stats = Catalyst::Stats->new;
121 my $node = Tree::Simple->new(
129 $stats->addChild( $node );
131 my $actual = $stats->{ tree }->{ _children }->[ 0 ];
132 is( $actual, $node, '[COMPAT] addChild()' );
133 is( $actual->getNodeValue->{ elapsed }, 10, '[COMPAT] addChild(), data munged' );
138 my $stats = Catalyst::Stats->new;
145 $stats->setNodeValue( $stat );
147 is_deeply( $stats->{tree}->getNodeValue, { action => 'test', elapsed => 10, comment => '' } , '[COMPAT] setNodeValue(), data munged' );
152 my $stats = Catalyst::Stats->new;
153 my $expected = $stats->{tree}->getNodeValue->{t};
154 is_deeply( $stats->getNodeValue, $expected, '[COMPAT] getNodeValue()' );
159 my $stats = Catalyst::Stats->new;
160 $stats->{tree}->addChild( Tree::Simple->new( { foo => 'bar' } ) );
162 $stats->traverse( sub { push @value, shift->getNodeValue->{ foo }; } );
164 is_deeply( \@value, [ 'bar' ], '[COMPAT] traverse()' );