File Coverage

inc/Test/NoWarnings/Warning.pm
Criterion Covered Total %
statement 31 38 81.5
branch 2 4 50.0
condition n/a
subroutine 10 16 62.5
pod 0 11 0.0
total 43 69 62.3


line stmt bran cond sub pod time code
1             package Test::NoWarnings::Warning;
2              
3 77     77   1143 use 5.006;
  77         217  
4 77     77   325 use strict;
  77         112  
  77         1471  
5 77     77   341 use Carp ();
  77         124  
  77         1717  
6              
7 77     77   377 use vars qw{$VERSION};
  77         152  
  77         5248  
8             BEGIN {
9 77     77   233 $VERSION = '1.02';
10              
11             # Optional stacktrace support
12 77         5607 eval "require Devel::StackTrace";
13             }
14              
15             sub new {
16 6     6 0 9 my $class = shift;
17 6         16 bless { @_ }, $class;
18             }
19              
20             sub getTrace {
21 0     0 0 0 $_[0]->{Trace};
22             }
23              
24             sub fillTrace {
25 6     6 0 8 my $self = shift;
26 6 50       12 $self->{Trace} = Devel::StackTrace->new(
27             ignore_class => [__PACKAGE__, @_],
28             ) if $Devel::StackTrace::VERSION;
29             }
30              
31             sub getCarp {
32 0     0 0 0 $_[0]->{Carp};
33             }
34              
35             sub fillCarp {
36 6     6 0 6 my $self = shift;
37 6         7 my $msg = shift;
38 6         8 $Carp::Internal{ __PACKAGE__ . "" }++;
39 6         7 local $Carp::CarpLevel = $Carp::CarpLevel + 1;
40 6         679 $self->{Carp} = Carp::longmess($msg);
41 6         171 $Carp::Internal{ __PACKAGE__ . "" }--;
42             }
43              
44             sub getMessage {
45 0     0 0 0 $_[0]->{Message};
46             }
47              
48             sub setMessage {
49 6     6 0 17 $_[0]->{Message} = $_[1];
50             }
51              
52             sub fillTest {
53 6     6 0 7 my $self = shift;
54 6         6 my $builder = shift;
55 6         16 my $prev_test = $builder->current_test;
56 6         646 $self->{Test} = $prev_test;
57 6         12 my @tests = $builder->details;
58 6 50       618 my $prev_test_name = $prev_test ? $tests[$prev_test - 1]->{name} : "";
59 6         18 $self->{TestName} = $prev_test_name;
60             }
61              
62             sub getTest {
63 0     0 0   $_[0]->{Test};
64             }
65              
66             sub getTestName {
67 0     0 0   $_[0]->{TestName};
68             }
69              
70             sub toString {
71 0     0 0   my $self = shift;
72 0           return <
73             Previous test $self->{Test} '$self->{TestName}'
74             $self->{Carp}
75             EOM
76             }
77              
78             1;