File Coverage

blib/lib/Test2/Util/Trace.pm
Criterion Covered Total %
statement 36 36 100.0
branch 8 8 100.0
condition n/a
subroutine 15 15 100.0
pod 8 10 80.0
total 67 69 97.1


line stmt bran cond sub pod time code
1             package Test2::Util::Trace;
2 57     57   479 use strict;
  57         64  
  57         1245  
3 57     57   165 use warnings;
  57         49  
  57         2183  
4              
5             our $VERSION = '0.000043';
6             $VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
7              
8 57     57   183 use Test2::Util qw/get_tid/;
  57         68  
  57         2007  
9              
10 57     57   192 use Carp qw/confess/;
  57         55  
  57         1881  
11              
12 57     57   17206 use Test2::Util::HashBase qw{frame detail pid tid};
  57         80  
  57         385  
13              
14             sub init {
15             confess "The 'frame' attribute is required"
16 139 100   139 0 508 unless $_[0]->{+FRAME};
17              
18 138 100       435 $_[0]->{+PID} = $$ unless defined $_[0]->{+PID};
19 138 100       508 $_[0]->{+TID} = get_tid() unless defined $_[0]->{+TID};
20             }
21              
22 173     173 0 161 sub snapshot { bless {%{$_[0]}}, __PACKAGE__ };
  173         1220  
23              
24             sub debug {
25 34     34 1 32 my $self = shift;
26 34 100       66 return $self->{+DETAIL} if $self->{+DETAIL};
27 33         53 my ($pkg, $file, $line) = $self->call;
28 33         127 return "at $file line $line";
29             }
30              
31             sub alert {
32 3     3 1 22 my $self = shift;
33 3         6 my ($msg) = @_;
34 3         9 warn $msg . ' ' . $self->debug . ".\n";
35             }
36              
37             sub throw {
38 5     5 1 15 my $self = shift;
39 5         11 my ($msg) = @_;
40 5         13 die $msg . ' ' . $self->debug . ".\n";
41             }
42              
43 34     34 1 30 sub call { @{$_[0]->{+FRAME}} }
  34         74  
44              
45 1     1 1 4 sub package { $_[0]->{+FRAME}->[0] }
46 1     1 1 4 sub file { $_[0]->{+FRAME}->[1] }
47 1     1 1 3 sub line { $_[0]->{+FRAME}->[2] }
48 1     1 1 3 sub subname { $_[0]->{+FRAME}->[3] }
49              
50             1;
51              
52             __END__