File Coverage

blib/lib/Test/NoWarnings/Warning.pm
Criterion Covered Total %
statement 35 39 89.7
branch 3 4 75.0
condition n/a
subroutine 12 16 75.0
pod 0 11 0.0
total 50 70 71.4


line stmt bran cond sub pod time code
1             package Test::NoWarnings::Warning;
2              
3 7     7   91 use 5.006;
  7         19  
  7         249  
4 7     7   32 use strict;
  7         9  
  7         197  
5 7     7   38 use Carp ();
  7         12  
  7         196  
6              
7 7     7   34 use vars qw{$VERSION};
  7         10  
  7         390  
8             BEGIN {
9 7     7   20 $VERSION = '1.04';
10              
11             # Optional stacktrace support
12 7         433 eval "require Devel::StackTrace";
13             }
14              
15             sub new {
16 4     4 0 7 my $class = shift;
17 4         13 bless { @_ }, $class;
18             }
19              
20             sub getTrace {
21 0     0 0 0 $_[0]->{Trace};
22             }
23              
24             sub fillTrace {
25 4     4 0 5 my $self = shift;
26 4 50       14 $self->{Trace} = Devel::StackTrace->new(
27             ignore_class => [__PACKAGE__, @_],
28             ) if $Devel::StackTrace::VERSION;
29             }
30              
31             sub getCarp {
32 1     1 0 17 $_[0]->{Carp};
33             }
34              
35             sub fillCarp {
36 4     4 0 4 my $self = shift;
37 4         4 my $msg = shift;
38 4         5 $Carp::Internal{ __PACKAGE__ . "" }++;
39 4         4 local $Carp::CarpLevel = $Carp::CarpLevel + 1;
40 4         743 $self->{Carp} = Carp::longmess($msg);
41 4         537 $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 4 my $self = shift;
54 4         4 my $builder = shift;
55 4         13 my $prev_test = $builder->current_test;
56 4         18 $self->{Test} = $prev_test;
57 4         11 my @tests = $builder->details;
58 4 100       19 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 6     6 0 4 my $self = shift;
72 6         43 return <
73             Previous test $self->{Test} '$self->{TestName}'
74             $self->{Carp}
75             EOM
76             }
77              
78             1;