diff options
| -rw-r--r-- | XSUB.h | 2 | ||||
| -rw-r--r-- | embed.fnc | 1 | ||||
| -rw-r--r-- | embed.h | 2 | ||||
| -rw-r--r-- | global.sym | 1 | ||||
| -rw-r--r-- | pad.c | 13 | ||||
| -rw-r--r-- | pp.c | 7 | ||||
| -rw-r--r-- | proto.h | 1 | ||||
| -rw-r--r-- | t/op/mydef.t | 2 |
8 files changed, 26 insertions, 3 deletions
@@ -114,7 +114,7 @@ is a lexical $_ in scope. #define XSINTERFACE_FUNC_SET(cv,f) \ CvXSUBANY(cv).any_dxptr = (void (*) (pTHX_ void*))(f) -#define dUNDERBAR I32 padoff_du = pad_findmy("$_") +#define dUNDERBAR I32 padoff_du = Perl_find_rundefsvoffset() #define UNDERBAR ((padoff_du == NOT_IN_PAD \ || PAD_COMPNAME_FLAGS(padoff_du) & SVpad_OUR) \ ? DEFSV : PAD_SVl(padoff_du)) @@ -551,6 +551,7 @@ p |void |package |OP* o pd |PADOFFSET|pad_alloc |I32 optype|U32 tmptype p |PADOFFSET|allocmy |char* name pd |PADOFFSET|pad_findmy |char* name +Ap |PADOFFSET|find_rundefsvoffset | p |OP* |oopsAV |OP* o p |OP* |oopsHV |OP* o pd |void |pad_leavemy @@ -761,6 +761,7 @@ #ifdef PERL_CORE #define pad_findmy Perl_pad_findmy #endif +#define find_rundefsvoffset Perl_find_rundefsvoffset #ifdef PERL_CORE #define oopsAV Perl_oopsAV #endif @@ -3387,6 +3388,7 @@ #ifdef PERL_CORE #define pad_findmy(a) Perl_pad_findmy(aTHX_ a) #endif +#define find_rundefsvoffset() Perl_find_rundefsvoffset(aTHX) #ifdef PERL_CORE #define oopsAV(a) Perl_oopsAV(aTHX_ a) #endif diff --git a/global.sym b/global.sym index 46b6458e9b..d97151ebf1 100644 --- a/global.sym +++ b/global.sym @@ -329,6 +329,7 @@ Perl_vstringify Perl_vcmp Perl_ninstr Perl_op_free +Perl_find_rundefsvoffset Perl_pad_sv Perl_reentrant_size Perl_reentrant_init @@ -582,6 +582,19 @@ Perl_pad_findmy(pTHX_ char *name) return NOT_IN_PAD; } +/* + * Returns the offset of a lexical $_, if there is one, at run time. + * Used by the UNDERBAR XS macro. + */ + +PADOFFSET +Perl_find_rundefsvoffset() +{ + SV *out_sv; + int out_flags; + return pad_findlex("$_", find_runcv(NULL), PL_curcop->cop_seq, 1, + Null(SV**), &out_sv, &out_flags); +} /* =for apidoc pad_findlex @@ -4334,12 +4334,17 @@ PP(pp_reverse) register I32 tmp; dTARGET; STRLEN len; + I32 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 : DEFSV); + sv_setsv(TARG, (SP > MARK) + ? *SP + : (padoff_du = Perl_find_rundefsvoffset(), + (padoff_du == NOT_IN_PAD || PAD_COMPNAME_FLAGS(padoff_du) & SVpad_OUR) + ? DEFSV : PAD_SVl(padoff_du))); up = SvPV_force(TARG, len); if (len > 1) { if (DO_UTF8(TARG)) { /* first reverse each character */ @@ -529,6 +529,7 @@ PERL_CALLCONV void Perl_package(pTHX_ OP* o); PERL_CALLCONV PADOFFSET Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype); PERL_CALLCONV PADOFFSET Perl_allocmy(pTHX_ char* name); PERL_CALLCONV PADOFFSET Perl_pad_findmy(pTHX_ char* name); +PERL_CALLCONV PADOFFSET Perl_find_rundefsvoffset(pTHX); PERL_CALLCONV OP* Perl_oopsAV(pTHX_ OP* o); PERL_CALLCONV OP* Perl_oopsHV(pTHX_ OP* o); PERL_CALLCONV void Perl_pad_leavemy(pTHX); diff --git a/t/op/mydef.t b/t/op/mydef.t index 485f8431a5..f089c31b0c 100644 --- a/t/op/mydef.t +++ b/t/op/mydef.t @@ -164,7 +164,7 @@ $_ = "global"; { my $_ = "abc"; my $x = reverse; - ok( $x eq "cba", 'reverse without arguments picks up $_ # TODO' ); + ok( $x eq "cba", 'reverse without arguments picks up $_' ); } { |