if ((o->op_private & OPpTARGET_MY)
&& (PL_opargs[o->op_type] & OA_TARGLEX))/* OPp share the meaning */
{
- scalar(o); /* As if inside SASSIGN */
+ /* newASSIGNOP has already applied scalar context, which we
+ leave, as if this op is inside SASSIGN. */
continue;
}
=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;
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) {
}
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
#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 *
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. */