diff options
| -rw-r--r-- | embed.fnc | 2 | ||||
| -rw-r--r-- | embed.h | 2 | ||||
| -rw-r--r-- | global.sym | 1 | ||||
| -rw-r--r-- | pad.c | 22 | ||||
| -rw-r--r-- | pod/perl5132delta.pod | 2 | ||||
| -rw-r--r-- | pp.c | 9 | ||||
| -rw-r--r-- | proto.h | 1 | ||||
| -rw-r--r-- | t/op/reverse.t | 14 |
8 files changed, 43 insertions, 10 deletions
@@ -856,6 +856,8 @@ p |PADOFFSET|allocmy |NN const char *const name|const STRLEN len\ : Used in op.c and toke.c AMpdR |PADOFFSET|pad_findmy |NN const char* name|STRLEN len|U32 flags Ap |PADOFFSET|find_rundefsvoffset | +: Used in pp.c +Ap |SV* |find_rundefsv | : Used in perly.y pR |OP* |oopsAV |NN OP* o : Used in perly.y @@ -673,6 +673,7 @@ #endif #define pad_findmy Perl_pad_findmy #define find_rundefsvoffset Perl_find_rundefsvoffset +#define find_rundefsv Perl_find_rundefsv #ifdef PERL_CORE #define oopsAV Perl_oopsAV #define oopsHV Perl_oopsHV @@ -3106,6 +3107,7 @@ #endif #define pad_findmy(a,b,c) Perl_pad_findmy(aTHX_ a,b,c) #define find_rundefsvoffset() Perl_find_rundefsvoffset(aTHX) +#define find_rundefsv() Perl_find_rundefsv(aTHX) #ifdef PERL_CORE #define oopsAV(a) Perl_oopsAV(aTHX_ a) #define oopsHV(a) Perl_oopsHV(aTHX_ a) diff --git a/global.sym b/global.sym index 8861fca218..5ab0090b99 100644 --- a/global.sym +++ b/global.sym @@ -396,6 +396,7 @@ Perl_ninstr Perl_op_free Perl_pad_findmy Perl_find_rundefsvoffset +Perl_find_rundefsv Perl_pad_sv Perl_reentrant_size Perl_reentrant_init @@ -704,6 +704,28 @@ Perl_find_rundefsvoffset(pTHX) } /* + * Returns a lexical $_, if there is one, at run time ; or the global one + * otherwise. + */ + +SV * +Perl_find_rundefsv(pTHX) +{ + SV *namesv; + int flags; + PADOFFSET po; + + po = pad_findlex("$_", find_runcv(NULL), PL_curcop->cop_seq, 1, + NULL, &namesv, &flags); + + if (po == NOT_IN_PAD + || (SvFLAGS(namesv) & (SVpad_NAME|SVpad_OUR)) == (SVpad_NAME|SVpad_OUR)) + return DEFSV; + + return PAD_SVl(po); +} + +/* =for apidoc pad_findlex Find a named lexical anywhere in a chain of nested pads. Add fake entries diff --git a/pod/perl5132delta.pod b/pod/perl5132delta.pod index fe457730bb..613f8144c6 100644 --- a/pod/perl5132delta.pod +++ b/pod/perl5132delta.pod @@ -182,7 +182,7 @@ XXX Changes which affect the interface available to C<XS> code go here. =item * The following new functions or macros have been added to the public API: -C<SvNV_nomg>, C<sv_2nv_flags>. +C<SvNV_nomg>, C<sv_2nv_flags>, C<find_rundefsv>. =back @@ -5489,19 +5489,12 @@ PP(pp_reverse) register I32 tmp; dTARGET; STRLEN len; - PADOFFSET padoff_du; SvUTF8_off(TARG); /* decontaminate */ if (SP - MARK > 1) do_join(TARG, &PL_sv_no, MARK, SP); else { - sv_setsv(TARG, (SP > MARK) - ? *SP - : (padoff_du = find_rundefsvoffset(), - (padoff_du == NOT_IN_PAD - || PAD_COMPNAME_FLAGS_isOUR(padoff_du)) - ? DEFSV : PAD_SVl(padoff_du))); - + sv_setsv(TARG, SP > MARK ? *SP : find_rundefsv()); if (! SvOK(TARG) && ckWARN(WARN_UNINITIALIZED)) report_uninit(TARG); } @@ -2510,6 +2510,7 @@ PERL_CALLCONV PADOFFSET Perl_pad_findmy(pTHX_ const char* name, STRLEN len, U32 assert(name) PERL_CALLCONV PADOFFSET Perl_find_rundefsvoffset(pTHX); +PERL_CALLCONV SV* Perl_find_rundefsv(pTHX); PERL_CALLCONV OP* Perl_oopsAV(pTHX_ OP* o) __attribute__warn_unused_result__ __attribute__nonnull__(pTHX_1); diff --git a/t/op/reverse.t b/t/op/reverse.t index 2fa0877202..916724c0df 100644 --- a/t/op/reverse.t +++ b/t/op/reverse.t @@ -6,7 +6,7 @@ BEGIN { require './test.pl'; } -plan tests => 23; +plan tests => 26; is(reverse("abc"), "cba"); @@ -91,3 +91,15 @@ use Tie::Array; my $c = scalar reverse($b); is($a, $c); } + +{ + # Lexical $_. + sub blurp { my $_ = shift; reverse } + + is(blurp("foo"), "oof"); + is(sub { my $_ = shift; reverse }->("bar"), "rab"); + { + local $_ = "XXX"; + is(blurp("paz"), "zap"); + } +} |