Permalink
Browse files

Fix test() using Sub::Uplevel so that caller() ignores the wrapping s…

…ub and

test() routine.  As if it was inside a bare block.  This allows testing of
things that use caller() like carp().
  • Loading branch information...
schwern committed Oct 4, 2008
1 parent 3bea737 commit b73b8d261436b8de9d18be5b8e640985692ad611
Showing with 31 additions and 7 deletions.
  1. +3 −2 Build.PL
  2. +5 −4 MANIFEST
  3. +2 −1 lib/Test/More/Behaviours.pm
  4. +21 −0 t/caller.t
@@ -8,8 +8,9 @@ my $builder = Module::Build->new(
dist_author => 'Rija Menage <cpan@rijam.sent.as>',
dist_version_from => 'lib/Test/More/Behaviours.pm',
requires => {
'Test::More' => 0,
'version' => 0,
'Test::More' => 0,
'version' => 0,
'Sub::Uplevel' => '0.16',
},
add_to_cleanup => [ 'Test-More-Behaviours-*' ],
);
@@ -1,15 +1,16 @@
.cvsignore
Build.PL
Changes
MANIFEST
META.yml # Will be created by "make dist"
lib/Test/More/Behaviours.pm
Makefile.PL
MANIFEST
META.yml # Will be created by "make dist"
README
lib/Test/More/Behaviours.pm
t/00.load.t
t/01.behaviours.t
t/perlcritic.t
t/caller.t
t/kwalitee.t
t/login_recipe.t
t/perlcritic.t
t/pod-coverage.t
t/pod.t
@@ -3,6 +3,7 @@ package Test::More::Behaviours;
use warnings;
use strict;
use Carp;
use Sub::Uplevel;

use version; our $VERSION = qv('0.0.2');

@@ -27,7 +28,7 @@ sub test {
my $block = shift;
print "\n" . LOG_COMMENT_CHARACTER ." " . $description . "\n";
&main::set_up if main->can('set_up');
&$block;
uplevel 2, $block;
&main::tear_down if main->can('tear_down');
}

@@ -0,0 +1,21 @@
#!perl -w

use strict;

{
package Foo;
use Test::More::Behaviours 'no_plan';

sub foo {
test 'caller() is not munged' => sub {
is_deeply [caller], ['Foo', $0, 19], 'basic caller()' or diag join " ", caller;
is_deeply [(caller(0))[0..7]],
['Foo', $0, 19, 'Foo::foo', 1, undef, undef, undef],
'hardcore caller()';
}
}

#line 19
foo();
}

0 comments on commit b73b8d2

Please sign in to comment.