AFS
view release on metacpan - search on metacpan
view release on metacpan or search on metacpan
src/inc/Test/Builder.pm view on Meta::CPAN
no strict 'refs';
return defined ${$pack.'::TODO'} ? ${$pack.'::TODO'}
: 0;
}
sub caller {
my($self, $height) = @_;
$height ||= 0;
my @caller = CORE::caller($self->level + $height + 1);
return wantarray ? @caller : $caller[0];
}
sub _sanity_check {
_whoa($Curr_Test < 0, 'Says here you ran a negative number of tests!');
_whoa(!$Have_Plan and $Curr_Test,
'Somehow your tests ran without a plan!');
_whoa($Curr_Test != @Test_Results,
'Somehow you got a different number of results than tests ran!');
}
sub _whoa {
my($check, $desc) = @_;
if( $check ) {
die <<WHOA;
WHOA! $desc
This should never happen! Please contact the author immediately!
WHOA
}
}
sub _my_exit {
$? = $_[0];
return 1;
}
$SIG{__DIE__} = sub {
# We don't want to muck with death in an eval, but $^S isn't
# totally reliable. 5.005_03 and 5.6.1 both do the wrong thing
# with it. Instead, we use caller. This also means it runs under
# 5.004!
my $in_eval = 0;
for( my $stack = 1; my $sub = (CORE::caller($stack))[3]; $stack++ ) {
$in_eval = 1 if $sub =~ /^\(eval\)/;
}
$Test_Died = 1 unless $in_eval;
};
sub _ending {
my $self = shift;
_sanity_check();
# Don't bother with an ending if this is a forked copy. Only the parent
# should do the ending.
do{ _my_exit($?) && return } if $Original_Pid != $$;
# Bailout if plan() was never called. This is so
# "require Test::Simple" doesn't puke.
do{ _my_exit(0) && return } if !$Have_Plan && !$Test_Died;
# Figure out if we passed or failed and print helpful messages.
if( @Test_Results ) {
# The plan? We have no plan.
if( $No_Plan ) {
$self->_print("1..$Curr_Test\n") unless $self->no_header;
$Expected_Tests = $Curr_Test;
}
# 5.8.0 threads bug. Shared arrays will not be auto-extended
# by a slice. Worse, we have to fill in every entry else
# we'll get an "Invalid value for shared scalar" error
for my $idx ($#Test_Results..$Expected_Tests-1) {
my %empty_result = ();
share(%empty_result);
$Test_Results[$idx] = \%empty_result
unless defined $Test_Results[$idx];
}
my $num_failed = grep !$_->{'ok'}, @Test_Results[0..$Expected_Tests-1];
$num_failed += abs($Expected_Tests - @Test_Results);
if( $Curr_Test < $Expected_Tests ) {
$self->diag(<<"FAIL");
Looks like you planned $Expected_Tests tests but only ran $Curr_Test.
FAIL
}
elsif( $Curr_Test > $Expected_Tests ) {
my $num_extra = $Curr_Test - $Expected_Tests;
$self->diag(<<"FAIL");
Looks like you planned $Expected_Tests tests but ran $num_extra extra.
FAIL
}
elsif ( $num_failed ) {
$self->diag(<<"FAIL");
Looks like you failed $num_failed tests of $Expected_Tests.
FAIL
}
if( $Test_Died ) {
$self->diag(<<"FAIL");
Looks like your test died just after $Curr_Test.
FAIL
_my_exit( 255 ) && return;
}
_my_exit( $num_failed <= 254 ? $num_failed : 254 ) && return;
}
elsif ( $Skip_All ) {
_my_exit( 0 ) && return;
}
elsif ( $Test_Died ) {
$self->diag(<<'FAIL');
view all matches for this distributionview release on metacpan - search on metacpan
( run in 1.581 second using v1.00-cache-2.02-grep-82fe00e-cpan-72ae3ad1e6da )