t/unit_stats.t

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