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   688 use strict;
  109         115  
  109         2557  
3 109     109   349 use warnings;
  109         94  
  109         2509  
4              
5 109     109   338 use Test::Stream::Util qw/get_tid/;
  109         105  
  109         481  
6              
7 109     109   407 use Carp qw/confess/;
  109         125  
  109         5647  
8              
9             use Test::Stream::HashBase(
10 109         635 accessors => [qw/frame todo skip detail pid tid parent_todo/],
11 109     109   37703 );
  109         165  
12              
13             sub init {
14             confess "Frame is required"
15 1035 100   1035 0 2239 unless $_[0]->{+FRAME};
16              
17 1034   33     3845 $_[0]->{+PID} ||= $$;
18 1034   50     3736 $_[0]->{+TID} ||= get_tid();
19             }
20              
21 310     310 0 314 sub snapshot { bless {%{$_[0]}}, __PACKAGE__ };
  310         3302  
22              
23             sub trace {
24 337     337 1 535 my $self = shift;
25 337 100       830 return $self->{+DETAIL} if $self->{+DETAIL};
26 200         386 my ($pkg, $file, $line) = $self->call;
27 200         783 return "at $file line $line";
28             }
29              
30             sub alert {
31 5     5 1 14 my $self = shift;
32 5         10 my ($msg) = @_;
33 5         15 warn $msg . ' ' . $self->trace . ".\n";
34             }
35              
36             sub throw {
37 7     7 1 25 my $self = shift;
38 7         11 my ($msg) = @_;
39 7         19 die $msg . ' ' . $self->trace . ".\n";
40             }
41              
42 201     201 1 168 sub call { @{$_[0]->{+FRAME}} }
  201         492  
43              
44 12     12 1 52 sub package { $_[0]->{+FRAME}->[0] }
45 245     245 1 1227 sub file { $_[0]->{+FRAME}->[1] }
46 217     217 1 741 sub line { $_[0]->{+FRAME}->[2] }
47 6     6 1 35 sub subname { $_[0]->{+FRAME}->[3] }
48              
49             sub no_diag {
50 258     258 0 754 my $self = shift;
51             return defined($self->{+TODO})
52             || defined($self->{+SKIP})
53 258   100     1653 || defined($self->{+PARENT_TODO});
54             }
55              
56             sub no_fail {
57 221     221 0 231 my $self = shift;
58             return defined($self->{+TODO})
59 221   100     1638 || defined($self->{+SKIP});
60             }
61              
62             1;
63              
64             __END__