In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/e8ed61c58cadd53d80a36d3e3a3fa0abdb90834d?hp=c22c99bc35171a7072ba6278b8a0fdbbaa86236a>
- Log ----------------------------------------------------------------- commit e8ed61c58cadd53d80a36d3e3a3fa0abdb90834d Author: Father Chrysostomos <[email protected]> Date: Fri Sep 16 18:57:37 2011 -0700 Tests for goto &xsub and lexical hints This new script tests that goto &xsub causes the sub to see the hints, not of the subroutine it replaces, but of that subroutineâs caller. M MANIFEST M ext/XS-APItest/APItest.xs A ext/XS-APItest/t/gotosub.t commit 309aab3af38b00c733d3e986808e79b53ffc4bab Author: Father Chrysostomos <[email protected]> Date: Fri Sep 16 18:54:57 2011 -0700 Make goto &CORE::sub use the right lexical scope Since goto &foo is supposed to replace the current sub call, as though foo had been called instead, logically foo should see the same lexical hints that would have been seen if it had been called to begin with. Regular Perl subs begin with nextstate ops, so they have their own lexical scopes, but CORE:: subs see the callerâs PL_curcop. They lack a nextstate precisely so that they run in the callerâs scope, just as though a built-in function had been called. For Perl subs (as opposed to XSUBs), goto-&sub was not reset- ting PL_curcop to the callerâs value, but leaving as it was, so goto &CORE::sub would cause the CORE sub to run with the lexical hints of the subroutine in replaced, instead of that subâs caller. This was never a problem until CORE subs came along, as they look like Perl subs to the internals (they have an op tree and are flagged as such), but comprise a sequence of ops that can never result from com- piling Perl source code. The simple one-line fix is to set PL_curcop in pp_goto for Perl subs as well as XSUBs. (For XSUBs it is implied by POPBLOCK.) M pod/perldelta.pod M pp_ctl.c M t/op/coresubs.t ----------------------------------------------------------------------- Summary of changes: MANIFEST | 1 + ext/XS-APItest/APItest.xs | 8 ++++++++ ext/XS-APItest/t/gotosub.t | 17 +++++++++++++++++ pod/perldelta.pod | 9 +++++++++ pp_ctl.c | 1 + t/op/coresubs.t | 7 +++++++ 6 files changed, 43 insertions(+), 0 deletions(-) create mode 100644 ext/XS-APItest/t/gotosub.t diff --git a/MANIFEST b/MANIFEST index eee925c..1cd70f6 100644 --- a/MANIFEST +++ b/MANIFEST @@ -3805,6 +3805,7 @@ ext/XS-APItest/t/customop.t XS::APItest: tests for custom ops ext/XS-APItest/t/eval-filter.t Simple source filter/eval test ext/XS-APItest/t/exception.t XS::APItest extension ext/XS-APItest/t/fetch_pad_names.t Tests for UTF8 names in pad +ext/XS-APItest/t/gotosub.t XS::APItest: tests goto &xsub and hints ext/XS-APItest/t/grok.t XS::APItest: tests for grok* functions ext/XS-APItest/t/hash.t XS::APItest: tests for hash related APIs ext/XS-APItest/t/keyword_multiline.t test keyword plugin parsing across lines diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs index 9b0d53a..37f7a0e 100644 --- a/ext/XS-APItest/APItest.xs +++ b/ext/XS-APItest/APItest.xs @@ -2983,6 +2983,14 @@ CODE: OUTPUT: RETVAL +void +stringify(SV *sv) +PREINIT: + const char *pv; +CODE: + pv = SvPV_nolen(sv); + + MODULE = XS::APItest PACKAGE = XS::APItest::Magic PROTOTYPES: DISABLE diff --git a/ext/XS-APItest/t/gotosub.t b/ext/XS-APItest/t/gotosub.t new file mode 100644 index 0000000..c665aaf --- /dev/null +++ b/ext/XS-APItest/t/gotosub.t @@ -0,0 +1,17 @@ +#!perl -w + +# Test that goto &xsub provides the right lexical environment. + +use strict; + +use Test::More tests => 1; +use XS::APItest; + +# This sub must remain outside the âuse warningsâ scope. +sub no_warnings { goto &stringify } + +use warnings; + +$SIG{__WARN__} = sub { like shift, qr\^Use of uninitialized\ }; + +no_warnings(my $x) # undefined variable diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 8b09500..7b79df8 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -809,6 +809,15 @@ variable [perl #98662]. C<++> and C<--> now work on copies of globs, instead of dying. +=item * + +The subroutines in the CORE:: namespace that were introduced in the +previous development release run with the lexical hints (strict, warnings) +of the caller, just as though the built-in function had been called. But +this was not the case for C<goto &CORE::sub>. The CORE sub would end up +running with the lexical hints of the subroutine it replaced, instead of +that subroutine's caller. This has been fixed. + =back =head1 Known Problems diff --git a/pp_ctl.c b/pp_ctl.c index e8907b6..603d0a5 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -2908,6 +2908,7 @@ PP(pp_goto) } cx->blk_sub.cv = cv; cx->blk_sub.olddepth = CvDEPTH(cv); + PL_curcop = cx->blk_oldcop; CvDEPTH(cv)++; if (CvDEPTH(cv) < 2) diff --git a/t/op/coresubs.t b/t/op/coresubs.t index f0ebe8e..b3dd3ce 100644 --- a/t/op/coresubs.t +++ b/t/op/coresubs.t @@ -108,6 +108,13 @@ while(<$kh>) { } } +$tests++; +# This subroutine is outside the warnings scope: +sub foo { goto &CORE::abs } +use warnings; +$SIG{__WARN__} = sub { like shift, qr\^Use of uninitialized\ }; +foo(undef); + is curr_test, $tests+1, 'right number of tests'; done_testing; -- Perl5 Master Repository
