1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106
|
use strict;
package Test::NoWarnings::Warning;
use Carp;
my $has_st = eval "require Devel::StackTrace" || 0;
sub new
{
my $pkg = shift;
my %args = @_;
my $self = bless \%args, $pkg;
return $self;
}
sub getTrace
{
my $self = shift;
return $self->{Trace};
}
sub fillTrace
{
my $self = shift;
$self->{Trace} = Devel::StackTrace->new(
ignore_class => [__PACKAGE__, @_],
) if $has_st;
}
sub getCarp
{
my $self = shift;
return $self->{Carp};
}
sub fillCarp
{
my $self = shift;
my $msg = shift;
$Carp::Internal{__PACKAGE__.""}++;
local $Carp::CarpLevel = $Carp::CarpLevel + 1;
$self->{Carp} = Carp::longmess($msg);
$Carp::Internal{__PACKAGE__.""}--;
}
sub getMessage
{
my $self = shift;
return $self->{Message};
}
sub setMessage
{
my $self = shift;
$self->{Message} = shift;
}
sub fillTest
{
my $self = shift;
my $builder = shift;
my $prev_test = $builder->current_test;
$self->{Test} = $prev_test;
my @tests = $builder->details;
my $prev_test_name = $prev_test ? $tests[$prev_test - 1]->{name} : "";
$self->{TestName} = $prev_test_name;
}
sub getTest
{
my $self = shift;
return $self->{Test};
}
sub getTestName
{
my $self = shift;
return $self->{TestName};
}
sub toString
{
my $self = shift;
return <<EOM;
Previous test $self->{Test} '$self->{TestName}'
$self->{Carp}
EOM
}
1;
|