t/unit_stats.t

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