diff options
| -rw-r--r-- | embed.fnc | 1 | ||||
| -rw-r--r-- | embed.h | 1 | ||||
| -rw-r--r-- | op.c | 42 | ||||
| -rw-r--r-- | proto.h | 1 | ||||
| -rw-r--r-- | t/op/lexsub.t | 4 | ||||
| -rw-r--r-- | toke.c | 9 |
6 files changed, 34 insertions, 24 deletions
@@ -427,6 +427,7 @@ p |void |dump_sub_perl |NN const GV* gv|bool justperl Apd |void |fbm_compile |NN SV* sv|U32 flags ApdR |char* |fbm_instr |NN unsigned char* big|NN unsigned char* bigend \ |NN SV* littlestr|U32 flags +p |CV * |find_lexical_cv|PADOFFSET off : Defined in util.c, used only in perl.c p |char* |find_script |NN const char *scriptname|bool dosearch \ |NULLOK const char *const *const search_ext|I32 flags @@ -1090,6 +1090,7 @@ #define dump_packsubs_perl(a,b) Perl_dump_packsubs_perl(aTHX_ a,b) #define dump_sub_perl(a,b) Perl_dump_sub_perl(aTHX_ a,b) #define finalize_optree(a) Perl_finalize_optree(aTHX_ a) +#define find_lexical_cv(a) Perl_find_lexical_cv(aTHX_ a) #define find_runcv_where(a,b,c) Perl_find_runcv_where(aTHX_ a,b,c) #define find_rundefsv2(a,b) Perl_find_rundefsv2(aTHX_ a,b) #define find_script(a,b,c,d) Perl_find_script(aTHX_ a,b,c,d) @@ -8189,7 +8189,6 @@ Perl_newCVREF(pTHX_ I32 flags, OP *o) dVAR; o->op_type = OP_PADCV; o->op_ppaddr = PL_ppaddr[OP_PADCV]; - return o; } return newUNOP(OP_RV2CV, flags, scalar(o)); } @@ -9910,6 +9909,28 @@ subroutine. =cut */ +/* shared by toke.c:yylex */ +CV * +Perl_find_lexical_cv(pTHX_ PADOFFSET off) +{ + PADNAME *name = PAD_COMPNAME(off); + CV *compcv = PL_compcv; + while (PadnameOUTER(name)) { + assert(PARENT_PAD_INDEX(name)); + compcv = CvOUTSIDE(PL_compcv); + name = PadlistNAMESARRAY(CvPADLIST(compcv)) + [off = PARENT_PAD_INDEX(name)]; + } + assert(!PadnameIsOUR(name)); + if (!PadnameIsSTATE(name)) { + MAGIC * mg = mg_find(name, PERL_MAGIC_proto); + assert(mg); + assert(mg->mg_obj); + return (CV *)mg->mg_obj; + } + return (CV *)AvARRAY(PadlistARRAY(CvPADLIST(compcv))[1])[off]; +} + CV * Perl_rv2cv_op_cv(pTHX_ OP *cvop, U32 flags) { @@ -9944,24 +9965,7 @@ Perl_rv2cv_op_cv(pTHX_ OP *cvop, U32 flags) gv = NULL; } break; case OP_PADCV: { - PADNAME *name = PAD_COMPNAME(rvop->op_targ); - CV *compcv = PL_compcv; - PADOFFSET off = rvop->op_targ; - while (PadnameOUTER(name)) { - assert(PARENT_PAD_INDEX(name)); - compcv = CvOUTSIDE(PL_compcv); - name = PadlistNAMESARRAY(CvPADLIST(compcv)) - [off = PARENT_PAD_INDEX(name)]; - } - assert(!PadnameIsOUR(name)); - if (!PadnameIsSTATE(name)) { - MAGIC * mg = mg_find(name, PERL_MAGIC_proto); - assert(mg); - assert(mg->mg_obj); - cv = (CV *)mg->mg_obj; - } - else cv = - (CV *)AvARRAY(PadlistARRAY(CvPADLIST(compcv))[1])[off]; + cv = find_lexical_cv(rvop->op_targ); gv = NULL; } break; default: { @@ -1087,6 +1087,7 @@ PERL_CALLCONV void Perl_finalize_optree(pTHX_ OP* o) #define PERL_ARGS_ASSERT_FINALIZE_OPTREE \ assert(o) +PERL_CALLCONV CV * Perl_find_lexical_cv(pTHX_ PADOFFSET off); PERL_CALLCONV CV* Perl_find_runcv(pTHX_ U32 *db_seqp) __attribute__warn_unused_result__; diff --git a/t/op/lexsub.t b/t/op/lexsub.t index b6960e03ed..0e101e865f 100644 --- a/t/op/lexsub.t +++ b/t/op/lexsub.t @@ -8,7 +8,7 @@ BEGIN { *bar::like = *like; } no warnings 'deprecated'; -plan 132; +plan 134; # -------------------- Errors with feature disabled -------------------- # @@ -299,6 +299,7 @@ sub make_anon_with_state_sub{ is ref $_[0], 'ARRAY', 'state sub with proto'; } p(my @a); + p my @b; state sub q () { 45 } is q(), 45, 'state constant called with parens'; } @@ -598,6 +599,7 @@ not_lexical11(); is ref $_[0], 'ARRAY', 'my sub with proto'; } p(my @a); + p @a; my sub q () { 46 } is q(), 46, 'my constant called with parens'; } @@ -6936,8 +6936,7 @@ Perl_yylex(pTHX) else { rv2cv_op = newOP(OP_PADANY, 0); rv2cv_op->op_targ = off; - rv2cv_op = (OP*)newCVREF(0, rv2cv_op); - cv = (CV *)PAD_SV(off); + cv = find_lexical_cv(off); } lex = TRUE; goto just_a_word; @@ -7266,7 +7265,8 @@ Perl_yylex(pTHX) } op_free(pl_yylval.opval); - pl_yylval.opval = rv2cv_op; + pl_yylval.opval = + off ? (OP *)newCVREF(0, rv2cv_op) : rv2cv_op; pl_yylval.opval->op_private |= OPpENTERSUB_NOPAREN; PL_last_lop = PL_oldbufptr; PL_last_lop_op = OP_ENTERSUB; @@ -7362,7 +7362,8 @@ Perl_yylex(pTHX) gv = gv_fetchpv(PL_tokenbuf, GV_ADD | ( UTF ? SVf_UTF8 : 0 ), SVt_PVCV); op_free(pl_yylval.opval); - pl_yylval.opval = rv2cv_op; + pl_yylval.opval = + off ? (OP *)newCVREF(0, rv2cv_op) : rv2cv_op; pl_yylval.opval->op_private |= OPpENTERSUB_NOPAREN; PL_last_lop = PL_oldbufptr; PL_last_lop_op = OP_ENTERSUB; |