File Coverage

blib/lib/Test/Stream/DebugInfo.pm
Criterion Covered Total %
statement 40 40 100.0
branch 4 4 100.0
condition 8 11 72.7
subroutine 17 17 100.0
pod 8 12 66.6
total 77 84 91.6


line stmt bran cond sub pod time code
1             package Test::Stream::DebugInfo;
2 109     109   1064 use strict;
  109         229  
  109         2767  
3 109     109   520 use warnings;
  109         164  
  109         3163  
4              
5 109     109   537 use Test::Stream::Util qw/get_tid/;
  109         178  
  109         643  
6              
7 109     109   584 use Carp qw/confess/;
  109         185  
  109         6866  
8              
9             use Test::Stream::HashBase(
10 109         942 accessors => [qw/frame todo skip detail pid tid parent_todo/],
11 109     109   59085 );
  109         247  
12              
13             sub init {
14             confess "Frame is required"
15 1030 100   1030 0 3587 unless $_[0]->{+FRAME};
16              
17 1029   33     5629 $_[0]->{+PID} ||= $$;
18 1029   50     5983 $_[0]->{+TID} ||= get_tid();
19             }
20              
21 309     309 0 477 sub snapshot { bless {%{$_[0]}}, __PACKAGE__ };
  309         4376  
22              
23             sub trace {
24 329     329 1 895 my $self = shift;
25 329 100       1209 return $self->{+DETAIL} if $self->{+DETAIL};
26 192         516 my ($pkg, $file, $line) = $self->call;
27 192         932 return "at $file line $line";
28             }
29              
30             sub alert {
31 5     5 1 23 my $self = shift;
32 5         11 my ($msg) = @_;
33 5         20 warn $msg . ' ' . $self->trace . ".\n";
34             }
35              
36             sub throw {
37 7     7 1 40 my $self = shift;
38 7         14 my ($msg) = @_;
39 7         25 die $msg . ' ' . $self->trace . ".\n";
40             }
41              
42 193     193 1 261 sub call { @{$_[0]->{+FRAME}} }
  193         744  
43              
44 12     12 1 68 sub package { $_[0]->{+FRAME}->[0] }
45 237     237 1 1619 sub file { $_[0]->{+FRAME}->[1] }
46 209     209 1 1131 sub line { $_[0]->{+FRAME}->[2] }
47 6     6 1 34 sub subname { $_[0]->{+FRAME}->[3] }
48              
49             sub no_diag {
50 257     257 0 1165 my $self = shift;
51             return defined($self->{+TODO})
52             || defined($self->{+SKIP})
53 257   100     2470 || defined($self->{+PARENT_TODO});
54             }
55              
56             sub no_fail {
57 212     212 0 351 my $self = shift;
58             return defined($self->{+TODO})
59 212   100     2302 || defined($self->{+SKIP});
60             }
61              
62             1;
63              
64             __END__