t/unit_stats.t

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