File Coverage

blib/lib/Test/NoWarnings/Warning.pm
Criterion Covered Total %
statement 32 36 88.8
branch 3 4 75.0
condition n/a
subroutine 11 15 73.3
pod 0 11 0.0
total 46 66 69.7


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