SV *useless_sv = NULL;
const char* useless = NULL;
- if (o->op_type == OP_NEXTSTATE
- || o->op_type == OP_DBSTATE
- || (o->op_type == OP_NULL && (o->op_targ == OP_NEXTSTATE
- || o->op_targ == OP_DBSTATE)))
- PL_curcop = (COP*)o; /* for warning below */
+ if (o->op_type == OP_NEXTSTATE
+ || o->op_type == OP_DBSTATE
+ || (o->op_type == OP_NULL && (o->op_targ == OP_NEXTSTATE
+ || o->op_targ == OP_DBSTATE)))
+ PL_curcop = (COP*)o; /* for warning below */
+
+ /* assumes no premature commitment */
+ want = o->op_flags & OPf_WANT;
+ if ((want && want != OPf_WANT_SCALAR)
+ || (PL_parser && PL_parser->error_count)
+ || o->op_type == OP_RETURN || o->op_type == OP_REQUIRE || o->op_type == OP_LEAVEWHEN)
+ {
+ continue;
+ }
- /* assumes no premature commitment */
- want = o->op_flags & OPf_WANT;
- if ((want && want != OPf_WANT_SCALAR)
- || (PL_parser && PL_parser->error_count)
- || o->op_type == OP_RETURN || o->op_type == OP_REQUIRE || o->op_type == OP_LEAVEWHEN)
- {
- continue;
- }
+ if ((o->op_private & OPpTARGET_MY)
+ && (PL_opargs[o->op_type] & OA_TARGLEX))/* OPp share the meaning */
+ {
+ /* newASSIGNOP has already applied scalar context, which we
+ leave, as if this op is inside SASSIGN. */
+ continue;
+ }
- if ((o->op_private & OPpTARGET_MY)
- && (PL_opargs[o->op_type] & OA_TARGLEX))/* OPp share the meaning */
- {
- scalar(o); /* As if inside SASSIGN */
- continue;
- }
+ o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_VOID;
- o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_VOID;
+ switch (o->op_type) {
+ default:
+ if (!(PL_opargs[o->op_type] & OA_FOLDCONST))
+ break;
+ /* FALLTHROUGH */
+ case OP_REPEAT:
+ if (o->op_flags & OPf_STACKED)
+ break;
+ goto func_ops;
+ case OP_SUBSTR:
+ if (o->op_private == 4)
+ break;
+ /* FALLTHROUGH */
+ case OP_WANTARRAY:
+ case OP_GV:
+ case OP_SMARTMATCH:
+ case OP_AV2ARYLEN:
+ case OP_REF:
+ case OP_REFGEN:
+ case OP_SREFGEN:
+ case OP_DEFINED:
+ case OP_HEX:
+ case OP_OCT:
+ case OP_LENGTH:
+ case OP_VEC:
+ case OP_INDEX:
+ case OP_RINDEX:
+ case OP_SPRINTF:
+ case OP_KVASLICE:
+ case OP_KVHSLICE:
+ case OP_UNPACK:
+ case OP_PACK:
+ case OP_JOIN:
+ case OP_LSLICE:
+ case OP_ANONLIST:
+ case OP_ANONHASH:
+ case OP_SORT:
+ case OP_REVERSE:
+ case OP_RANGE:
+ case OP_FLIP:
+ case OP_FLOP:
+ case OP_CALLER:
+ case OP_FILENO:
+ case OP_EOF:
+ case OP_TELL:
+ case OP_GETSOCKNAME:
+ case OP_GETPEERNAME:
+ case OP_READLINK:
+ case OP_TELLDIR:
+ case OP_GETPPID:
+ case OP_GETPGRP:
+ case OP_GETPRIORITY:
+ case OP_TIME:
+ case OP_TMS:
+ case OP_LOCALTIME:
+ case OP_GMTIME:
+ case OP_GHBYNAME:
+ case OP_GHBYADDR:
+ case OP_GHOSTENT:
+ case OP_GNBYNAME:
+ case OP_GNBYADDR:
+ case OP_GNETENT:
+ case OP_GPBYNAME:
+ case OP_GPBYNUMBER:
+ case OP_GPROTOENT:
+ case OP_GSBYNAME:
+ case OP_GSBYPORT:
+ case OP_GSERVENT:
+ case OP_GPWNAM:
+ case OP_GPWUID:
+ case OP_GGRNAM:
+ case OP_GGRGID:
+ case OP_GETLOGIN:
+ case OP_PROTOTYPE:
+ case OP_RUNCV:
+ func_ops:
+ useless = OP_DESC(o);
+ break;
- switch (o->op_type) {
- default:
- if (!(PL_opargs[o->op_type] & OA_FOLDCONST))
- break;
- /* FALLTHROUGH */
- case OP_REPEAT:
- if (o->op_flags & OPf_STACKED)
- break;
- goto func_ops;
- case OP_SUBSTR:
- if (o->op_private == 4)
- break;
- /* FALLTHROUGH */
- case OP_GVSV:
- case OP_WANTARRAY:
- case OP_GV:
- case OP_SMARTMATCH:
- case OP_PADSV:
- case OP_PADAV:
- case OP_PADHV:
- case OP_PADANY:
- case OP_AV2ARYLEN:
- case OP_REF:
- case OP_REFGEN:
- case OP_SREFGEN:
- case OP_DEFINED:
- case OP_HEX:
- case OP_OCT:
- case OP_LENGTH:
- case OP_VEC:
- case OP_INDEX:
- case OP_RINDEX:
- case OP_SPRINTF:
- case OP_AELEM:
- case OP_AELEMFAST:
- case OP_AELEMFAST_LEX:
- case OP_ASLICE:
- case OP_KVASLICE:
- case OP_HELEM:
- case OP_HSLICE:
- case OP_KVHSLICE:
- case OP_UNPACK:
- case OP_PACK:
- case OP_JOIN:
- case OP_LSLICE:
- case OP_ANONLIST:
- case OP_ANONHASH:
- case OP_SORT:
- case OP_REVERSE:
- case OP_RANGE:
- case OP_FLIP:
- case OP_FLOP:
- case OP_CALLER:
- case OP_FILENO:
- case OP_EOF:
- case OP_TELL:
- case OP_GETSOCKNAME:
- case OP_GETPEERNAME:
- case OP_READLINK:
- case OP_TELLDIR:
- case OP_GETPPID:
- case OP_GETPGRP:
- case OP_GETPRIORITY:
- case OP_TIME:
- case OP_TMS:
- case OP_LOCALTIME:
- case OP_GMTIME:
- case OP_GHBYNAME:
- case OP_GHBYADDR:
- case OP_GHOSTENT:
- case OP_GNBYNAME:
- case OP_GNBYADDR:
- case OP_GNETENT:
- case OP_GPBYNAME:
- case OP_GPBYNUMBER:
- case OP_GPROTOENT:
- case OP_GSBYNAME:
- case OP_GSBYPORT:
- case OP_GSERVENT:
- case OP_GPWNAM:
- case OP_GPWUID:
- case OP_GGRNAM:
- case OP_GGRGID:
- case OP_GETLOGIN:
- case OP_PROTOTYPE:
- case OP_RUNCV:
- func_ops:
- if (!(o->op_private & (OPpLVAL_INTRO|OPpOUR_INTRO)))
- /* Otherwise it's "Useless use of grep iterator" */
- useless = OP_DESC(o);
- break;
+ case OP_GVSV:
+ case OP_PADSV:
+ case OP_PADAV:
+ case OP_PADHV:
+ case OP_PADANY:
+ case OP_AELEM:
+ case OP_AELEMFAST:
+ case OP_AELEMFAST_LEX:
+ case OP_ASLICE:
+ case OP_HELEM:
+ case OP_HSLICE:
+ if (!(o->op_private & (OPpLVAL_INTRO|OPpOUR_INTRO)))
+ /* Otherwise it's "Useless use of grep iterator" */
+ useless = OP_DESC(o);
+ break;
- case OP_SPLIT:
- kid = cLISTOPo->op_first;
- if (kid && kid->op_type == OP_PUSHRE
- && !kid->op_targ
- && !(o->op_flags & OPf_STACKED)
+ case OP_SPLIT:
+ kid = cLISTOPo->op_first;
+ if (kid && kid->op_type == OP_PUSHRE
+ && !kid->op_targ
+ && !(o->op_flags & OPf_STACKED)
#ifdef USE_ITHREADS
- && !((PMOP*)kid)->op_pmreplrootu.op_pmtargetoff
+ && !((PMOP*)kid)->op_pmreplrootu.op_pmtargetoff
#else
- && !((PMOP*)kid)->op_pmreplrootu.op_pmtargetgv
+ && !((PMOP*)kid)->op_pmreplrootu.op_pmtargetgv
#endif
- )
- useless = OP_DESC(o);
- break;
-
- case OP_NOT:
- kid = cUNOPo->op_first;
- if (kid->op_type != OP_MATCH && kid->op_type != OP_SUBST &&
- kid->op_type != OP_TRANS && kid->op_type != OP_TRANSR) {
- goto func_ops;
- }
- useless = "negative pattern binding (!~)";
- break;
+ )
+ useless = OP_DESC(o);
+ break;
- case OP_SUBST:
- if (cPMOPo->op_pmflags & PMf_NONDESTRUCT)
- useless = "non-destructive substitution (s///r)";
- break;
+ case OP_NOT:
+ kid = cUNOPo->op_first;
+ if (kid->op_type != OP_MATCH && kid->op_type != OP_SUBST &&
+ kid->op_type != OP_TRANS && kid->op_type != OP_TRANSR) {
+ goto func_ops;
+ }
+ useless = "negative pattern binding (!~)";
+ break;
- case OP_TRANSR:
- useless = "non-destructive transliteration (tr///r)";
- break;
+ case OP_SUBST:
+ if (cPMOPo->op_pmflags & PMf_NONDESTRUCT)
+ useless = "non-destructive substitution (s///r)";
+ break;
- case OP_RV2GV:
- case OP_RV2SV:
- case OP_RV2AV:
- case OP_RV2HV:
- if (!(o->op_private & (OPpLVAL_INTRO|OPpOUR_INTRO)) &&
- (!OP_HAS_SIBLING(o) || OP_SIBLING(o)->op_type != OP_READLINE))
- useless = "a variable";
- break;
+ case OP_TRANSR:
+ useless = "non-destructive transliteration (tr///r)";
+ break;
- case OP_CONST:
- sv = cSVOPo_sv;
- if (cSVOPo->op_private & OPpCONST_STRICT)
- no_bareword_allowed(o);
- else {
- if (ckWARN(WARN_VOID)) {
- NV nv;
- /* don't warn on optimised away booleans, eg
- * use constant Foo, 5; Foo || print; */
- if (cSVOPo->op_private & OPpCONST_SHORTCIRCUIT)
- useless = NULL;
- /* the constants 0 and 1 are permitted as they are
- conventionally used as dummies in constructs like
- 1 while some_condition_with_side_effects; */
- else if (SvNIOK(sv) && ((nv = SvNV(sv)) == 0.0 || nv == 1.0))
- useless = NULL;
- else if (SvPOK(sv)) {
- SV * const dsv = newSVpvs("");
- useless_sv
- = Perl_newSVpvf(aTHX_
- "a constant (%s)",
- pv_pretty(dsv, SvPVX_const(sv),
- SvCUR(sv), 32, NULL, NULL,
- PERL_PV_PRETTY_DUMP
- | PERL_PV_ESCAPE_NOCLEAR
- | PERL_PV_ESCAPE_UNI_DETECT));
- SvREFCNT_dec_NN(dsv);
- }
- else if (SvOK(sv)) {
- useless_sv = Perl_newSVpvf(aTHX_ "a constant (%"SVf")", SVfARG(sv));
- }
- else
- useless = "a constant (undef)";
- }
- }
- op_null(o); /* don't execute or even remember it */
- break;
+ case OP_RV2GV:
+ case OP_RV2SV:
+ case OP_RV2AV:
+ case OP_RV2HV:
+ if (!(o->op_private & (OPpLVAL_INTRO|OPpOUR_INTRO)) &&
+ (!OP_HAS_SIBLING(o) || OP_SIBLING(o)->op_type != OP_READLINE))
+ useless = "a variable";
+ break;
- case OP_POSTINC:
- CHANGE_TYPE(o, OP_PREINC); /* pre-increment is faster */
- break;
+ case OP_CONST:
+ sv = cSVOPo_sv;
+ if (cSVOPo->op_private & OPpCONST_STRICT)
+ no_bareword_allowed(o);
+ else {
+ if (ckWARN(WARN_VOID)) {
+ NV nv;
+ /* don't warn on optimised away booleans, eg
+ * use constant Foo, 5; Foo || print; */
+ if (cSVOPo->op_private & OPpCONST_SHORTCIRCUIT)
+ useless = NULL;
+ /* the constants 0 and 1 are permitted as they are
+ conventionally used as dummies in constructs like
+ 1 while some_condition_with_side_effects; */
+ else if (SvNIOK(sv) && ((nv = SvNV(sv)) == 0.0 || nv == 1.0))
+ useless = NULL;
+ else if (SvPOK(sv)) {
+ SV * const dsv = newSVpvs("");
+ useless_sv
+ = Perl_newSVpvf(aTHX_
+ "a constant (%s)",
+ pv_pretty(dsv, SvPVX_const(sv),
+ SvCUR(sv), 32, NULL, NULL,
+ PERL_PV_PRETTY_DUMP
+ | PERL_PV_ESCAPE_NOCLEAR
+ | PERL_PV_ESCAPE_UNI_DETECT));
+ SvREFCNT_dec_NN(dsv);
+ }
+ else if (SvOK(sv)) {
+ useless_sv = Perl_newSVpvf(aTHX_ "a constant (%"SVf")", SVfARG(sv));
+ }
+ else
+ useless = "a constant (undef)";
+ }
+ }
+ op_null(o); /* don't execute or even remember it */
+ break;
- case OP_POSTDEC:
- CHANGE_TYPE(o, OP_PREDEC); /* pre-decrement is faster */
- break;
+ case OP_POSTINC:
+ CHANGE_TYPE(o, OP_PREINC); /* pre-increment is faster */
+ break;
- case OP_I_POSTINC:
- CHANGE_TYPE(o, OP_I_PREINC); /* pre-increment is faster */
- break;
+ case OP_POSTDEC:
+ CHANGE_TYPE(o, OP_PREDEC); /* pre-decrement is faster */
+ break;
- case OP_I_POSTDEC:
- CHANGE_TYPE(o, OP_I_PREDEC); /* pre-decrement is faster */
- break;
+ case OP_I_POSTINC:
+ CHANGE_TYPE(o, OP_I_PREINC); /* pre-increment is faster */
+ break;
- case OP_SASSIGN: {
- OP *rv2gv;
- UNOP *refgen, *rv2cv;
- LISTOP *exlist;
+ case OP_I_POSTDEC:
+ CHANGE_TYPE(o, OP_I_PREDEC); /* pre-decrement is faster */
+ break;
- if ((o->op_private & ~OPpASSIGN_BACKWARDS) != 2)
- break;
+ case OP_SASSIGN: {
+ OP *rv2gv;
+ UNOP *refgen, *rv2cv;
+ LISTOP *exlist;
- rv2gv = ((BINOP *)o)->op_last;
- if (!rv2gv || rv2gv->op_type != OP_RV2GV)
- break;
+ if ((o->op_private & ~OPpASSIGN_BACKWARDS) != 2)
+ break;
- refgen = (UNOP *)((BINOP *)o)->op_first;
+ rv2gv = ((BINOP *)o)->op_last;
+ if (!rv2gv || rv2gv->op_type != OP_RV2GV)
+ break;
- if (!refgen || (refgen->op_type != OP_REFGEN
- && refgen->op_type != OP_SREFGEN))
- break;
+ refgen = (UNOP *)((BINOP *)o)->op_first;
- exlist = (LISTOP *)refgen->op_first;
- if (!exlist || exlist->op_type != OP_NULL
- || exlist->op_targ != OP_LIST)
- break;
+ if (!refgen || (refgen->op_type != OP_REFGEN
+ && refgen->op_type != OP_SREFGEN))
+ break;
- if (exlist->op_first->op_type != OP_PUSHMARK
- && exlist->op_first != exlist->op_last)
- break;
+ exlist = (LISTOP *)refgen->op_first;
+ if (!exlist || exlist->op_type != OP_NULL
+ || exlist->op_targ != OP_LIST)
+ break;
- rv2cv = (UNOP*)exlist->op_last;
+ if (exlist->op_first->op_type != OP_PUSHMARK
+ && exlist->op_first != exlist->op_last)
+ break;
- if (rv2cv->op_type != OP_RV2CV)
- break;
+ rv2cv = (UNOP*)exlist->op_last;
- assert ((rv2gv->op_private & OPpDONT_INIT_GV) == 0);
- assert ((o->op_private & OPpASSIGN_CV_TO_GV) == 0);
- assert ((rv2cv->op_private & OPpMAY_RETURN_CONSTANT) == 0);
+ if (rv2cv->op_type != OP_RV2CV)
+ break;
- o->op_private |= OPpASSIGN_CV_TO_GV;
- rv2gv->op_private |= OPpDONT_INIT_GV;
- rv2cv->op_private |= OPpMAY_RETURN_CONSTANT;
+ assert ((rv2gv->op_private & OPpDONT_INIT_GV) == 0);
+ assert ((o->op_private & OPpASSIGN_CV_TO_GV) == 0);
+ assert ((rv2cv->op_private & OPpMAY_RETURN_CONSTANT) == 0);
- break;
- }
+ o->op_private |= OPpASSIGN_CV_TO_GV;
+ rv2gv->op_private |= OPpDONT_INIT_GV;
+ rv2cv->op_private |= OPpMAY_RETURN_CONSTANT;
- case OP_AASSIGN: {
- inplace_aassign(o);
- break;
- }
+ break;
+ }
- case OP_OR:
- case OP_AND:
- kid = cLOGOPo->op_first;
- if (kid->op_type == OP_NOT
- && (kid->op_flags & OPf_KIDS)) {
- if (o->op_type == OP_AND) {
- CHANGE_TYPE(o, OP_OR);
- } else {
- CHANGE_TYPE(o, OP_AND);
- }
- op_null(kid);
- }
- /* FALLTHROUGH */
+ case OP_AASSIGN: {
+ inplace_aassign(o);
+ break;
+ }
- case OP_DOR:
- case OP_COND_EXPR:
- case OP_ENTERGIVEN:
- case OP_ENTERWHEN:
- for (kid = OP_SIBLING(cUNOPo->op_first); kid; kid = OP_SIBLING(kid))
- if (!(kid->op_flags & OPf_KIDS))
- scalarvoid(kid);
- else
- DEFER_OP(kid);
- break;
+ case OP_OR:
+ case OP_AND:
+ kid = cLOGOPo->op_first;
+ if (kid->op_type == OP_NOT
+ && (kid->op_flags & OPf_KIDS)) {
+ if (o->op_type == OP_AND) {
+ CHANGE_TYPE(o, OP_OR);
+ } else {
+ CHANGE_TYPE(o, OP_AND);
+ }
+ op_null(kid);
+ }
+ /* FALLTHROUGH */
- case OP_NULL:
- if (o->op_flags & OPf_STACKED)
- break;
- /* FALLTHROUGH */
- case OP_NEXTSTATE:
- case OP_DBSTATE:
- case OP_ENTERTRY:
- case OP_ENTER:
- if (!(o->op_flags & OPf_KIDS))
- break;
- /* FALLTHROUGH */
- case OP_SCOPE:
- case OP_LEAVE:
- case OP_LEAVETRY:
- case OP_LEAVELOOP:
- case OP_LINESEQ:
- case OP_LEAVEGIVEN:
- case OP_LEAVEWHEN:
- kids:
- for (kid = cLISTOPo->op_first; kid; kid = OP_SIBLING(kid))
- if (!(kid->op_flags & OPf_KIDS))
- scalarvoid(kid);
- else
- DEFER_OP(kid);
- break;
- case OP_LIST:
- /* If the first kid after pushmark is something that the padrange
- optimisation would reject, then null the list and the pushmark.
- */
- if ((kid = cLISTOPo->op_first)->op_type == OP_PUSHMARK
- && ( !(kid = OP_SIBLING(kid))
- || ( kid->op_type != OP_PADSV
- && kid->op_type != OP_PADAV
- && kid->op_type != OP_PADHV)
- || kid->op_private & ~OPpLVAL_INTRO
- || !(kid = OP_SIBLING(kid))
- || ( kid->op_type != OP_PADSV
- && kid->op_type != OP_PADAV
- && kid->op_type != OP_PADHV)
- || kid->op_private & ~OPpLVAL_INTRO)
- ) {
- op_null(cUNOPo->op_first); /* NULL the pushmark */
- op_null(o); /* NULL the list */
- }
- goto kids;
- case OP_ENTEREVAL:
- scalarkids(o);
- break;
- case OP_SCALAR:
- scalar(o);
+ case OP_DOR:
+ case OP_COND_EXPR:
+ case OP_ENTERGIVEN:
+ case OP_ENTERWHEN:
+ for (kid = OP_SIBLING(cUNOPo->op_first); kid; kid = OP_SIBLING(kid))
+ if (!(kid->op_flags & OPf_KIDS))
+ scalarvoid(kid);
+ else
+ DEFER_OP(kid);
break;
- }
- if (useless_sv) {
- /* mortalise it, in case warnings are fatal. */
- Perl_ck_warner(aTHX_ packWARN(WARN_VOID),
- "Useless use of %"SVf" in void context",
- SVfARG(sv_2mortal(useless_sv)));
- }
- else if (useless) {
- Perl_ck_warner(aTHX_ packWARN(WARN_VOID),
- "Useless use of %s in void context",
- useless);
- }
+ case OP_NULL:
+ if (o->op_flags & OPf_STACKED)
+ break;
+ /* FALLTHROUGH */
+ case OP_NEXTSTATE:
+ case OP_DBSTATE:
+ case OP_ENTERTRY:
+ case OP_ENTER:
+ if (!(o->op_flags & OPf_KIDS))
+ break;
+ /* FALLTHROUGH */
+ case OP_SCOPE:
+ case OP_LEAVE:
+ case OP_LEAVETRY:
+ case OP_LEAVELOOP:
+ case OP_LINESEQ:
+ case OP_LEAVEGIVEN:
+ case OP_LEAVEWHEN:
+ kids:
+ for (kid = cLISTOPo->op_first; kid; kid = OP_SIBLING(kid))
+ if (!(kid->op_flags & OPf_KIDS))
+ scalarvoid(kid);
+ else
+ DEFER_OP(kid);
+ break;
+ case OP_LIST:
+ /* If the first kid after pushmark is something that the padrange
+ optimisation would reject, then null the list and the pushmark.
+ */
+ if ((kid = cLISTOPo->op_first)->op_type == OP_PUSHMARK
+ && ( !(kid = OP_SIBLING(kid))
+ || ( kid->op_type != OP_PADSV
+ && kid->op_type != OP_PADAV
+ && kid->op_type != OP_PADHV)
+ || kid->op_private & ~OPpLVAL_INTRO
+ || !(kid = OP_SIBLING(kid))
+ || ( kid->op_type != OP_PADSV
+ && kid->op_type != OP_PADAV
+ && kid->op_type != OP_PADHV)
+ || kid->op_private & ~OPpLVAL_INTRO)
+ ) {
+ op_null(cUNOPo->op_first); /* NULL the pushmark */
+ op_null(o); /* NULL the list */
+ }
+ goto kids;
+ case OP_ENTEREVAL:
+ scalarkids(o);
+ break;
+ case OP_SCALAR:
+ scalar(o);
+ break;
+ }
+
+ if (useless_sv) {
+ /* mortalise it, in case warnings are fatal. */
+ Perl_ck_warner(aTHX_ packWARN(WARN_VOID),
+ "Useless use of %"SVf" in void context",
+ SVfARG(sv_2mortal(useless_sv)));
+ }
+ else if (useless) {
+ Perl_ck_warner(aTHX_ packWARN(WARN_VOID),
+ "Useless use of %s in void context",
+ useless);
+ }
} while ( (o = POP_DEFERRED_OP()) );
Safefree(defer_stack);
=cut
*/
+static void
+S_mark_padname_lvalue(pTHX_ PADNAME *pn)
+{
+ CV *cv = PL_compcv;
+ PadnameLVALUE_on(pn);
+ while (PadnameOUTER(pn) && PARENT_PAD_INDEX(pn)) {
+ cv = CvOUTSIDE(cv);
+ assert(cv);
+ assert(CvPADLIST(cv));
+ pn =
+ PadlistNAMESARRAY(CvPADLIST(cv))[PARENT_PAD_INDEX(pn)];
+ assert(PadnameLEN(pn));
+ PadnameLVALUE_on(pn);
+ }
+}
+
static bool
S_vivifies(const OPCODE type)
{
if (!type) /* local() */
Perl_croak(aTHX_ "Can't localize lexical variable %"SVf,
PAD_COMPNAME_SV(o->op_targ));
+ if (!(o->op_private & OPpLVAL_INTRO)
+ || ( type != OP_SASSIGN && type != OP_AASSIGN
+ && PadnameIsSTATE(PAD_COMPNAME_SV(o->op_targ)) ))
+ S_mark_padname_lvalue(aTHX_ PAD_COMPNAME_SV(o->op_targ));
break;
case OP_PUSHMARK:
right->op_targ = 0;
right->op_private &= ~OPpTARGET_MY;
}
- if (!(right->op_flags & OPf_STACKED) && ismatchop) {
- OP *newleft;
-
- right->op_flags |= OPf_STACKED;
- if (rtype != OP_MATCH && rtype != OP_TRANSR &&
+ if (!(right->op_flags & OPf_STACKED) && !right->op_targ && ismatchop) {
+ if (left->op_type == OP_PADSV
+ && !(left->op_private & OPpLVAL_INTRO))
+ {
+ right->op_targ = left->op_targ;
+ op_free(left);
+ o = right;
+ }
+ else {
+ right->op_flags |= OPf_STACKED;
+ if (rtype != OP_MATCH && rtype != OP_TRANSR &&
! (rtype == OP_TRANS &&
right->op_private & OPpTRANS_IDENTICAL) &&
! (rtype == OP_SUBST &&
(cPMOPx(right)->op_pmflags & PMf_NONDESTRUCT)))
- newleft = op_lvalue(left, rtype);
- else
- newleft = left;
- if (right->op_type == OP_TRANS || right->op_type == OP_TRANSR)
- o = newBINOP(OP_NULL, OPf_STACKED, scalar(newleft), right);
- else
- o = op_prepend_elem(rtype, scalar(newleft), right);
+ left = op_lvalue(left, rtype);
+ if (right->op_type == OP_TRANS || right->op_type == OP_TRANSR)
+ o = newBINOP(OP_NULL, OPf_STACKED, scalar(left), right);
+ else
+ o = op_prepend_elem(rtype, scalar(left), right);
+ }
if (type == OP_NOT)
return newUNOP(OP_NOT, 0, scalar(o));
return o;
{
const int retval = PL_savestack_ix;
+ PL_compiling.cop_seq = PL_cop_seqmax;
+ COP_SEQMAX_INC;
pad_block_start(full);
SAVEHINTS();
PL_hints &= ~HINT_BLOCK_SCOPE;
SAVECOMPILEWARNINGS();
PL_compiling.cop_warnings = DUP_WARNINGS(PL_compiling.cop_warnings);
+ SAVEI32(PL_compiling.cop_seq);
+ PL_compiling.cop_seq = 0;
CALL_BLOCK_HOOKS(bhk_start, full);
UV tfirst = 1;
UV tlast = 0;
IV tdiff;
+ STRLEN tcount = 0;
UV rfirst = 1;
UV rlast = 0;
IV rdiff;
+ STRLEN rcount = 0;
IV diff;
I32 none = 0;
U32 max = 0;
/* now see which range will peter our first, if either. */
tdiff = tlast - tfirst;
rdiff = rlast - rfirst;
+ tcount += tdiff + 1;
+ rcount += rdiff + 1;
if (tdiff <= rdiff)
diff = tdiff;
(void)hv_store(MUTABLE_HV(SvRV(swash)), "FINAL", 5,
newSVuv((UV)final), 0);
- if (grows)
- o->op_private |= OPpTRANS_GROWS;
-
Safefree(tsave);
Safefree(rsave);
- op_free(expr);
- op_free(repl);
- return o;
+ tlen = tcount;
+ rlen = rcount;
+ if (r < rend)
+ rlen++;
+ else if (rlast == 0xffffffff)
+ rlen = 0;
+
+ goto warnins;
}
tbl = (short*)PerlMemShared_calloc(
}
}
+ warnins:
if(del && rlen == tlen) {
Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "Useless use of /d modifier in transliteration operator");
} else if(rlen > tlen && !complement) {
return CHECKOP(type, pmop);
}
+static void
+S_set_haseval(pTHX)
+{
+ PADOFFSET i = 1;
+ PL_cv_has_eval = 1;
+ /* Any pad names in scope are potentially lvalues. */
+ for (; i < PadnamelistMAXNAMED(PL_comppad_name); i++) {
+ PADNAME *pn = PAD_COMPNAME_SV(i);
+ if (!pn || !PadnameLEN(pn))
+ continue;
+ if (PadnameOUTER(pn) || PadnameIN_SCOPE(pn, PL_cop_seqmax))
+ S_mark_padname_lvalue(aTHX_ pn);
+ }
+}
+
/* Given some sort of match op o, and an expression expr containing a
* pattern, either compile expr into a regex and attach it to o (if it's
* constant), or convert expr into a runtime regcomp op sequence (if it's
rcop->op_targ = cv_targ;
/* /$x/ may cause an eval, since $x might be qr/(?{..})/ */
- if (PL_hints & HINT_RE_EVAL) PL_cv_has_eval = 1;
+ if (PL_hints & HINT_RE_EVAL)
+ S_set_haseval(aTHX);
/* establish postfix order */
if (expr->op_type == OP_REGCRESET || expr->op_type == OP_REGCMAYBE) {
PL_hints |= HINT_BLOCK_SCOPE;
PL_parser->copline = NOLINE;
- PL_cop_seqmax++; /* Purely for B::*'s benefit */
- if (PL_cop_seqmax == PERL_PADSEQ_INTRO) /* not a legal value */
- PL_cop_seqmax++;
-
+ COP_SEQMAX_INC; /* Purely for B::*'s benefit */
}
/*
}
cop->op_flags = (U8)flags;
CopHINTS_set(cop, PL_hints);
-#ifdef NATIVE_HINTS
- cop->op_private |= NATIVE_HINTS;
-#endif
#ifdef VMS
if (VMSISH_HUSHED) cop->op_private |= OPpHUSH_VMSISH;
#endif
}
/* op_const_sv: examine an optree to determine whether it's in-lineable.
- * Can be called in 3 ways:
+ * Can be called in 2 ways:
*
- * !cv
+ * !allow_lex
* look for a single OP_CONST with attached value: return the value
*
- * cv && CvCLONE(cv) && !CvCONST(cv)
+ * allow_lex && !CvCONST(cv);
*
* examine the clone prototype, and if contains only a single
- * OP_CONST referencing a pad const, or a single PADSV referencing
- * an outer lexical, return a non-zero value to indicate the CV is
- * a candidate for "constizing" at clone time
- *
- * cv && CvCONST(cv)
- *
- * We have just cloned an anon prototype that was marked as a const
- * candidate. Try to grab the current value, and in the case of
- * PADSV, ignore it if it has multiple references. In this case we
- * return a newly created *copy* of the value.
+ * OP_CONST, return the value; or if it contains a single PADSV ref-
+ * erencing an outer lexical, turn on CvCONST to indicate the CV is
+ * a candidate for "constizing" at clone time, and return NULL.
*/
-SV *
-Perl_op_const_sv(pTHX_ const OP *o, CV *cv)
+static SV *
+S_op_const_sv(pTHX_ const OP *o, CV *cv, bool allow_lex)
{
SV *sv = NULL;
+ bool padsv = FALSE;
- if (!o)
- return NULL;
-
- if (o->op_type == OP_LINESEQ && cLISTOPo->op_first)
- o = OP_SIBLING(cLISTOPo->op_first);
+ assert(o);
+ assert(cv);
for (; o; o = o->op_next) {
const OPCODE type = o->op_type;
- if (sv && o->op_next == o)
- return sv;
- if (o->op_next != o) {
- if (type == OP_NEXTSTATE
- || (type == OP_NULL && !(o->op_flags & OPf_KIDS))
+ if (type == OP_NEXTSTATE || type == OP_LINESEQ
+ || type == OP_NULL
|| type == OP_PUSHMARK)
continue;
- if (type == OP_DBSTATE)
+ if (type == OP_DBSTATE)
continue;
- }
- if (type == OP_LEAVESUB || type == OP_RETURN)
+ if (type == OP_LEAVESUB)
break;
if (sv)
return NULL;
sv = newSV(0);
SAVEFREESV(sv);
}
- else if (cv && type == OP_CONST) {
- sv = PAD_BASE_SV(CvPADLIST(cv), o->op_targ);
- if (!sv)
- return NULL;
- }
- else if (cv && type == OP_PADSV) {
- if (CvCONST(cv)) { /* newly cloned anon */
- sv = PAD_BASE_SV(CvPADLIST(cv), o->op_targ);
- /* the candidate should have 1 ref from this pad and 1 ref
- * from the parent */
- if (!sv || SvREFCNT(sv) != 2)
- return NULL;
- sv = newSVsv(sv);
- SvREADONLY_on(sv);
- return sv;
- }
- else {
+ else if (allow_lex && type == OP_PADSV) {
if (PAD_COMPNAME_FLAGS(o->op_targ) & SVf_FAKE)
+ {
sv = &PL_sv_undef; /* an arbitrary non-null value */
- }
+ padsv = TRUE;
+ }
+ else
+ return NULL;
}
else {
return NULL;
}
}
+ if (padsv) {
+ CvCONST_on(cv);
+ return NULL;
+ }
return sv;
}
CV *clonee = NULL;
HEK *hek = NULL;
bool reusable = FALSE;
+ OP *start;
#ifdef PERL_DEBUG_READONLY_OPS
OPSLAB *slab = NULL;
#endif
spot = (CV **)(svspot = &mg->mg_obj);
}
+ if (block) {
+ /* This makes sub {}; work as expected. */
+ if (block->op_type == OP_STUB) {
+ const line_t l = PL_parser->copline;
+ op_free(block);
+ block = newSTATEOP(0, NULL, 0);
+ PL_parser->copline = l;
+ }
+ block = CvLVALUE(compcv)
+ || (cv && CvLVALUE(cv) && !CvROOT(cv) && !CvXSUB(cv))
+ ? newUNOP(OP_LEAVESUBLV, 0,
+ op_lvalue(scalarseq(block), OP_LEAVESUBLV))
+ : newUNOP(OP_LEAVESUB, 0, scalarseq(block));
+ start = LINKLIST(block);
+ block->op_next = 0;
+ }
+
if (!block || !ps || *ps || attrs
- || (CvFLAGS(compcv) & CVf_BUILTIN_ATTRS)
+ || CvLVALUE(compcv)
)
const_sv = NULL;
else
- const_sv = op_const_sv(block, NULL);
+ const_sv = S_op_const_sv(aTHX_ start, compcv, FALSE);
if (cv) {
const bool exists = CvROOT(cv) || CvXSUB(cv);
CvCONST_on(cv);
CvISXSUB_on(cv);
PoisonPADLIST(cv);
+ CvFLAGS(cv) |= CvMETHOD(compcv);
op_free(block);
SvREFCNT_dec(compcv);
PL_compcv = NULL;
exit. */
PL_breakable_sub_gen++;
- /* This makes sub {}; work as expected. */
- if (block->op_type == OP_STUB) {
- OP* const newblock = newSTATEOP(0, NULL, 0);
- op_free(block);
- block = newblock;
- }
- CvROOT(cv) = CvLVALUE(cv)
- ? newUNOP(OP_LEAVESUBLV, 0,
- op_lvalue(scalarseq(block), OP_LEAVESUBLV))
- : newUNOP(OP_LEAVESUB, 0, scalarseq(block));
+ CvROOT(cv) = block;
CvROOT(cv)->op_private |= OPpREFCOUNTED;
OpREFCNT_set(CvROOT(cv), 1);
/* The cv no longer needs to hold a refcount on the slab, as CvROOT
#ifdef PERL_DEBUG_READONLY_OPS
slab = (OPSLAB *)CvSTART(cv);
#endif
- CvSTART(cv) = LINKLIST(CvROOT(cv));
- CvROOT(cv)->op_next = 0;
- CALL_PEEP(CvSTART(cv));
+ CvSTART(cv) = start;
+ CALL_PEEP(start);
finalize_optree(CvROOT(cv));
S_prune_chain_head(&CvSTART(cv));
pad_tidy(CvCLONE(cv) ? padtidy_SUBCLONE : padtidy_SUB);
- if (CvCLONE(cv)) {
- assert(!CvCONST(cv));
- if (ps && !*ps && op_const_sv(block, cv))
- CvCONST_on(cv);
- }
-
attrs:
if (attrs) {
/* Need to do a C<use attributes $stash_of_cv,\&cv,@attrs>. */
o ? SvPV_const(o_is_gv ? (SV *)o : cSVOPo->op_sv, namlen) : NULL;
bool has_name;
bool name_is_utf8 = o && !o_is_gv && SvUTF8(cSVOPo->op_sv);
+ OP *start;
#ifdef PERL_DEBUG_READONLY_OPS
OPSLAB *slab = NULL;
bool special = FALSE;
? (CV *)SvRV(gv)
: NULL;
+ if (block) {
+ /* This makes sub {}; work as expected. */
+ if (block->op_type == OP_STUB) {
+ const line_t l = PL_parser->copline;
+ op_free(block);
+ block = newSTATEOP(0, NULL, 0);
+ PL_parser->copline = l;
+ }
+ block = CvLVALUE(PL_compcv)
+ || (cv && CvLVALUE(cv) && !CvROOT(cv) && !CvXSUB(cv)
+ && (!isGV(gv) || !GvASSUMECV(gv)))
+ ? newUNOP(OP_LEAVESUBLV, 0,
+ op_lvalue(scalarseq(block), OP_LEAVESUBLV))
+ : newUNOP(OP_LEAVESUB, 0, scalarseq(block));
+ start = LINKLIST(block);
+ block->op_next = 0;
+ }
if (!block || !ps || *ps || attrs
- || (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS)
+ || CvLVALUE(PL_compcv)
)
const_sv = NULL;
else
- const_sv = op_const_sv(block, NULL);
+ const_sv =
+ S_op_const_sv(aTHX_ start, PL_compcv, CvCLONE(PL_compcv));
if (SvPOK(gv) || (SvROK(gv) && SvTYPE(SvRV(gv)) != SVt_PVCV)) {
assert (block);
CvCONST_on(cv);
CvISXSUB_on(cv);
PoisonPADLIST(cv);
+ CvFLAGS(cv) |= CvMETHOD(PL_compcv);
}
else {
- if (isGV(gv)) {
- if (name) GvCV_set(gv, NULL);
+ if (isGV(gv) || CvMETHOD(PL_compcv)) {
+ if (name && isGV(gv))
+ GvCV_set(gv, NULL);
cv = newCONSTSUB_flags(
NULL, name, namlen, name_is_utf8 ? SVf_UTF8 : 0,
const_sv
);
+ CvFLAGS(cv) |= CvMETHOD(PL_compcv);
}
else {
if (!SvROK(gv)) {
exit. */
PL_breakable_sub_gen++;
- /* This makes sub {}; work as expected. */
- if (block->op_type == OP_STUB) {
- OP* const newblock = newSTATEOP(0, NULL, 0);
- op_free(block);
- block = newblock;
- }
- CvROOT(cv) = CvLVALUE(cv)
- ? newUNOP(OP_LEAVESUBLV, 0,
- op_lvalue(scalarseq(block), OP_LEAVESUBLV))
- : newUNOP(OP_LEAVESUB, 0, scalarseq(block));
+ CvROOT(cv) = block;
CvROOT(cv)->op_private |= OPpREFCOUNTED;
OpREFCNT_set(CvROOT(cv), 1);
/* The cv no longer needs to hold a refcount on the slab, as CvROOT
#ifdef PERL_DEBUG_READONLY_OPS
slab = (OPSLAB *)CvSTART(cv);
#endif
- CvSTART(cv) = LINKLIST(CvROOT(cv));
- CvROOT(cv)->op_next = 0;
- CALL_PEEP(CvSTART(cv));
+ CvSTART(cv) = start;
+ CALL_PEEP(start);
finalize_optree(CvROOT(cv));
S_prune_chain_head(&CvSTART(cv));
pad_tidy(CvCLONE(cv) ? padtidy_SUBCLONE : padtidy_SUB);
- if (CvCLONE(cv)) {
- assert(!CvCONST(cv));
- if (ps && !*ps && op_const_sv(block, cv))
- CvCONST_on(cv);
- }
-
attrs:
if (attrs) {
/* Need to do a C<use attributes $stash_of_cv,\&cv,@attrs>. */
return cv;
}
+/*
+=for apidoc U||newXS
+
+Used by C<xsubpp> to hook up XSUBs as Perl subs. I<filename> needs to be
+static storage, as it is used directly as CvFILE(), without a copy being made.
+
+=cut
+*/
+
+CV *
+Perl_newXS(pTHX_ const char *name, XSUBADDR_t subaddr, const char *filename)
+{
+ PERL_ARGS_ASSERT_NEWXS;
+ return newXS_len_flags(
+ name, name ? strlen(name) : 0, subaddr, filename, NULL, NULL, 0
+ );
+}
+
CV *
Perl_newXS_flags(pTHX_ const char *name, XSUBADDR_t subaddr,
const char *const filename, const char *const proto,
}
CV *
+Perl_newXS_deffile(pTHX_ const char *name, XSUBADDR_t subaddr)
+{
+ PERL_ARGS_ASSERT_NEWXS_DEFFILE;
+ return newXS_len_flags(
+ name, name ? strlen(name) : 0, subaddr, NULL, NULL, NULL, 0
+ );
+}
+
+CV *
Perl_newXS_len_flags(pTHX_ const char *name, STRLEN len,
XSUBADDR_t subaddr, const char *const filename,
const char *const proto, SV **const_svp,
bool interleave = FALSE;
PERL_ARGS_ASSERT_NEWXS_LEN_FLAGS;
-
+ if (!subaddr)
+ Perl_croak_nocontext("panic: no address for '%s' in '%s'",
+ name, filename ? filename : PL_xsubfilename);
{
GV * const gv = gv_fetchpvn(
name ? name : PL_curstash ? "__ANON__" : "__ANON__::__ANON__",
name ? len : PL_curstash ? sizeof("__ANON__") - 1:
sizeof("__ANON__::__ANON__") - 1,
GV_ADDMULTI | flags, SVt_PVCV);
-
- if (!subaddr)
- Perl_croak(aTHX_ "panic: no address for '%s' in '%s'", name, filename);
-
+
if ((cv = (name ? GvCV(gv) : NULL))) {
if (GvCVGEN(gv)) {
/* just a cached method */
gv_method_changed(gv); /* newXS */
}
}
- if (!name)
- CvANON_on(cv);
+
CvGV_set(cv, gv);
- (void)gv_fetchfile(filename);
- CvFILE(cv) = (char *)filename; /* NOTE: not copied, as it is expected to be
- an external constant string */
- assert(!CvDYNFILE(cv)); /* cv_undef should have turned it off */
+ if(filename) {
+ (void)gv_fetchfile(filename);
+ assert(!CvDYNFILE(cv)); /* cv_undef should have turned it off */
+ if (flags & XS_DYNAMIC_FILENAME) {
+ CvDYNFILE_on(cv);
+ CvFILE(cv) = savepv(filename);
+ } else {
+ /* NOTE: not copied, as it is expected to be an external constant string */
+ CvFILE(cv) = (char *)filename;
+ }
+ } else {
+ assert((flags & XS_DYNAMIC_FILENAME) == 0 && PL_xsubfilename);
+ CvFILE(cv) = (char*)PL_xsubfilename;
+ }
CvISXSUB_on(cv);
CvXSUB(cv) = subaddr;
+#ifndef PERL_IMPLICIT_CONTEXT
+ CvHSCXT(cv) = &PL_stack_sp;
+#else
PoisonPADLIST(cv);
-
+#endif
+
if (name)
process_special_blocks(0, name, gv, cv);
- }
+ else
+ CvANON_on(cv);
+ } /* <- not a conditional branch */
+
- if (flags & XS_DYNAMIC_FILENAME) {
- CvFILE(cv) = savepv(filename);
- CvDYNFILE_on(cv);
- }
sv_setpv(MUTABLE_SV(cv), proto);
if (interleave) LEAVE;
return cv;
return cv;
}
-/*
-=for apidoc U||newXS
-
-Used by C<xsubpp> to hook up XSUBs as Perl subs. I<filename> needs to be
-static storage, as it is used directly as CvFILE(), without a copy being made.
-
-=cut
-*/
-
-CV *
-Perl_newXS(pTHX_ const char *name, XSUBADDR_t subaddr, const char *filename)
-{
- PERL_ARGS_ASSERT_NEWXS;
- return newXS_len_flags(
- name, name ? strlen(name) : 0, subaddr, filename, NULL, NULL, 0
- );
-}
-
void
Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block)
{
}
else {
scalar((OP*)kid);
- PL_cv_has_eval = 1;
+ S_set_haseval(aTHX);
}
}
else {
}
-OP *
-Perl_ck_sassign(pTHX_ OP *o)
+static OP *
+S_maybe_targlex(pTHX_ OP *o)
{
dVAR;
OP * const kid = cLISTOPo->op_first;
-
- PERL_ARGS_ASSERT_CK_SASSIGN;
-
/* has a disposable target? */
if ((PL_opargs[kid->op_type] & OA_TARGLEX)
&& !(kid->op_flags & OPf_STACKED)
/* Can just relocate the target. */
if (kkid && kkid->op_type == OP_PADSV
- && !(kkid->op_private & OPpLVAL_INTRO))
+ && (!(kkid->op_private & OPpLVAL_INTRO)
+ || kkid->op_private & OPpPAD_STATE))
{
kid->op_targ = kkid->op_targ;
kkid->op_targ = 0;
/* Now we do not need PADSV and SASSIGN.
- * first replace the PADSV with OP_SIBLING(o), then
- * detach kid and OP_SIBLING(o) from o */
- op_sibling_splice(o, kid, 1, OP_SIBLING(o));
- op_sibling_splice(o, NULL, -1, NULL);
+ * Detach kid and free the rest. */
+ op_sibling_splice(o, NULL, 1, NULL);
op_free(o);
- op_free(kkid);
kid->op_private |= OPpTARGET_MY; /* Used for context settings */
return kid;
}
}
+ return o;
+}
+
+OP *
+Perl_ck_sassign(pTHX_ OP *o)
+{
+ dVAR;
+ OP * const kid = cLISTOPo->op_first;
+
+ PERL_ARGS_ASSERT_CK_SASSIGN;
+
if (OP_HAS_SIBLING(kid)) {
OP *kkid = OP_SIBLING(kid);
- /* For state variable assignment, kkid is a list op whose op_last
- is a padsv. */
+ /* For state variable assignment with attributes, kkid is a list op
+ whose op_last is a padsv. */
if ((kkid->op_type == OP_PADSV ||
(OP_TYPE_IS_OR_WAS(kkid, OP_LIST) &&
(kkid = cLISTOPx(kkid)->op_last)->op_type == OP_PADSV
)
)
- && (kkid->op_private & OPpLVAL_INTRO)
- && SvPAD_STATE(PAD_COMPNAME_SV(kkid->op_targ))) {
+ && (kkid->op_private & (OPpLVAL_INTRO|OPpPAD_STATE))
+ == (OPpLVAL_INTRO|OPpPAD_STATE)) {
const PADOFFSET target = kkid->op_targ;
OP *const other = newOP(OP_PADSV,
kkid->op_flags
| ((kkid->op_private & ~OPpLVAL_INTRO) << 8));
OP *const first = newOP(OP_NULL, 0);
- OP *const nullop = newCONDOP(0, first, o, other);
+ OP *const nullop =
+ newCONDOP(0, first, S_maybe_targlex(aTHX_ o), other);
OP *const condop = first->op_next;
CHANGE_TYPE(condop, OP_ONCE);
return nullop;
}
}
- return o;
+ return S_maybe_targlex(aTHX_ o);
}
OP *
{
OP * const kid = OP_SIBLING(cUNOPo->op_first);
PERL_ARGS_ASSERT_CK_STRINGIFY;
- if (kid->op_type == OP_JOIN) {
+ if (kid->op_type == OP_JOIN || kid->op_type == OP_QUOTEMETA
+ || kid->op_type == OP_LC || kid->op_type == OP_LCFIRST
+ || kid->op_type == OP_UC || kid->op_type == OP_UCFIRST)
+ {
assert(!OP_HAS_SIBLING(kid));
op_sibling_splice(o, cUNOPo->op_first, -1, NULL);
op_free(o);
break;
case OP_RUNCV:
- if (!(o->op_private & OPpOFFBYONE) && !CvCLONE(PL_compcv)) {
+ if (!(o->op_private & OPpOFFBYONE) && !CvCLONE(PL_compcv)
+ && (!CvANON(PL_compcv) || (!PL_cv_has_eval && !PL_perldb)))
+ {
SV *sv;
if (CvEVAL(PL_compcv)) sv = &PL_sv_undef;
else {
/* We do the common-vars check here, rather than in newASSIGNOP
(as formerly), so that all lexical vars that get aliased are
marked as such before we do the check. */
+ /* There can’t be common vars if the lhs is a stub. */
+ if (OP_SIBLING(cLISTOPx(cBINOPo->op_last)->op_first)
+ == cLISTOPx(cBINOPo->op_last)->op_last
+ && cLISTOPx(cBINOPo->op_last)->op_last->op_type == OP_STUB)
+ {
+ o->op_private &=~ OPpASSIGN_COMMON;
+ break;
+ }
if (o->op_private & OPpASSIGN_COMMON) {
/* See the comment before S_aassign_common_vars concerning
PL_generation sorcery. */
https://perl5.git.perl.org / perl5.git / blobdiff