diff options
author | Nicholas Clark <nick@ccl4.org> | 2010-11-18 14:14:57 +0000 |
---|---|---|
committer | Nicholas Clark <nick@ccl4.org> | 2010-11-18 15:00:44 +0000 |
commit | ce057ba89da80863694d58259ca5a4408f7e44c8 (patch) | |
tree | a2e8a92b0350a90794e9c20241f722a6debec3d8 | |
parent | 3fa17e3fe56d4d905804c431b7d481cde59af509 (diff) | |
download | perl-ce057ba89da80863694d58259ca5a4408f7e44c8.tar.gz |
Test that the stash and file of a sub's definition overrides those of its stub.
This is the current behaviour for Perl_newATTRSUB(), and it turns out that we
have no test for it.
-rw-r--r-- | t/op/stash.t | 33 |
1 files changed, 31 insertions, 2 deletions
diff --git a/t/op/stash.t b/t/op/stash.t index 2c085a30c3..b52da7a673 100644 --- a/t/op/stash.t +++ b/t/op/stash.t @@ -7,7 +7,7 @@ BEGIN { BEGIN { require "./test.pl"; } -plan( tests => 47 ); +plan( tests => 51 ); # Used to segfault (bug #15479) fresh_perl_like( @@ -69,7 +69,7 @@ ok( eval q{ no warnings 'deprecated'; defined %schoenmaker:: }, 'works in eval(" } SKIP: { - eval { require B; 1 } or skip "no B", 23; + eval { require B; 1 } or skip "no B", 27; *b = \&B::svref_2object; my $CVf_ANON = B::CVf_ANON(); @@ -188,6 +188,35 @@ SKIP: { ok($gv->isa(q/B::GV/), "anon CV has valid GV"); is($gv->NAME, '__ANON__', "anon CV has anon GV"); } + + { + my $r; + { + package bloop; + + BEGIN { + $r = \&main::whack; + } + } + + my $br = B::svref_2object($r); + is ($br->STASH->NAME, 'bloop', + 'stub records the package it was compiled in'); + # Arguably this shouldn't quite be here, but it's easy to add it + # here, and tricky to figure out a different good place for it. + like ($br->FILE, qr/stash/i, + 'stub records the file it was compiled in'); + + # We need to take this reference "late", after the subroutine is + # defined. + $br = B::svref_2object(eval 'sub whack {}; \&whack'); + die $@ if $@; + + is ($br->STASH->NAME, 'main', + 'definition overrides the package it was compiled in'); + like ($br->FILE, qr/eval/, + 'definition overrides the file it was compiled in'); + } } # [perl #58530] |