lop = lop->op_sibling;
}
}
+ else if (((left->op_private & (OPpLVAL_INTRO | OPpPAD_STATE))
+ == (OPpLVAL_INTRO | OPpPAD_STATE))
+ && ( left->op_type == OP_PADSV
+ || left->op_type == OP_PADAV
+ || left->op_type == OP_PADHV
+ || left->op_type == OP_PADANY))
+ {
+ o->op_private |= OPpASSIGN_STATE;
+ /* hijacking PADSTALE for uninitialized state variables */
+ SvPADSTALE_on(PAD_SVl(left->op_targ));
+ }
if (right && right->op_type == OP_SPLIT) {
OP* tmpop = ((LISTOP*)right)->op_first;
scalarboolean(first);
if (first->op_type == OP_CONST) {
+ /* Left or right arm of the conditional? */
+ const bool left = SvTRUE(((SVOP*)first)->op_sv);
+ OP *live = left ? trueop : falseop;
+ OP *const dead = left ? falseop : trueop;
if (first->op_private & OPpCONST_BARE &&
first->op_private & OPpCONST_STRICT) {
no_bareword_allowed(first);
}
- if (SvTRUE(((SVOP*)first)->op_sv)) {
-#ifdef PERL_MAD
- if (PL_madskills) {
- trueop = newUNOP(OP_NULL, 0, trueop);
- op_getmad(first,trueop,'C');
- op_getmad(falseop,trueop,'e');
- }
- /* FIXME for MAD - should there be an ELSE here? */
-#else
- op_free(first);
- op_free(falseop);
-#endif
- return trueop;
- }
- else {
-#ifdef PERL_MAD
- if (PL_madskills) {
- falseop = newUNOP(OP_NULL, 0, falseop);
- op_getmad(first,falseop,'C');
- op_getmad(trueop,falseop,'t');
- }
- /* FIXME for MAD - should there be an ELSE here? */
-#else
+ if (PL_madskills) {
+ /* This is all dead code when PERL_MAD is not defined. */
+ live = newUNOP(OP_NULL, 0, live);
+ op_getmad(first, live, 'C');
+ op_getmad(dead, live, left ? 'e' : 't');
+ } else {
op_free(first);
- op_free(trueop);
-#endif
- return falseop;
+ op_free(dead);
}
+ return live;
}
NewOp(1101, logop, 1, LOGOP);
logop->op_type = OP_COND_EXPR;
iterpflags = sv->op_private & OPpOUR_INTRO; /* for our $x () */
sv->op_type = OP_RV2GV;
sv->op_ppaddr = PL_ppaddr[OP_RV2GV];
- if (cGVOPx_gv(cUNOPx(sv)->op_first) == PL_defgv)
+
+ /* The op_type check is needed to prevent a possible segfault
+ * if the loop variable is undeclared and 'strict vars' is in
+ * effect. This is illegal but is nonetheless parsed, so we
+ * may reach this point with an OP_CONST where we're expecting
+ * an OP_GV.
+ */
+ if (cUNOPx(sv)->op_first->op_type == OP_GV
+ && cGVOPx_gv(cUNOPx(sv)->op_first) == PL_defgv)
iterpflags |= OPpITER_DEF;
}
else if (sv->op_type == OP_PADSV) { /* private variable */
const char *const name = colon ? colon + 1 : fullname;
if (*name == 'B') {
- if (memEQ(name, "BEGIN", 5)) {
+ if (strEQ(name, "BEGIN")) {
const I32 oldscope = PL_scopestack_ix;
ENTER;
SAVECOPFILE(&PL_compiling);
}
}
-/* XXX unsafe for threads if eval_owner isn't held */
/*
=for apidoc newCONSTSUB
if (cv) /* must reuse cv if autoloaded */
cv_undef(cv);
else {
- cv = (CV*)newSV(0);
- sv_upgrade((SV *)cv, SVt_PVCV);
+ cv = (CV*)newSV_type(SVt_PVCV);
if (name) {
GvCV(gv) = cv;
GvCVGEN(gv) = 0;
}
o->op_targ = (PADOFFSET)PL_hints;
if ((PL_hints & HINT_LOCALIZE_HH) != 0 && GvHV(PL_hintgv)) {
- /* Store a copy of %^H that pp_entereval can pick up */
- OP *hhop = newSVOP(OP_CONST, 0,
+ /* Store a copy of %^H that pp_entereval can pick up.
+ OPf_SPECIAL flags the opcode as being for this purpose,
+ so that it in turn will return a copy at every
+ eval.*/
+ OP *hhop = newSVOP(OP_CONST, OPf_SPECIAL,
(SV*)Perl_hv_copy_hints_hv(aTHX_ GvHV(PL_hintgv)));
cUNOPo->op_first->op_sibling = hhop;
o->op_private |= OPpEVAL_HAS_HH;
}
OP *
+Perl_ck_readline(pTHX_ OP *o)
+{
+ if (!(o->op_flags & OPf_KIDS)) {
+ OP * const newop
+ = newUNOP(OP_READLINE, 0, newGVOP(OP_GV, 0, PL_argvgv));
+#ifdef PERL_MAD
+ op_getmad(o,newop,'O');
+#else
+ op_free(o);
+#endif
+ return newop;
+ }
+ return o;
+}
+
+OP *
Perl_ck_rfun(pTHX_ OP *o)
{
const OPCODE type = o->op_type;
o->op_private |= OPpOPEN_OUT_CRLF;
}
}
- if (o->op_type == OP_BACKTICK)
+ if (o->op_type == OP_BACKTICK) {
+ if (!(o->op_flags & OPf_KIDS)) {
+ OP * const newop = newUNOP(OP_BACKTICK, 0, newDEFSVOP());
+#ifdef PERL_MAD
+ op_getmad(o,newop,'O');
+#else
+ op_free(o);
+#endif
+ return newop;
+ }
return o;
+ }
{
/* In case of three-arg dup open remove strictness
* from the last arg if it is a bareword. */
const STRLEN len = re ? re->prelen : 6;
Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
"/%.*s/ should probably be written as \"%.*s\"",
- len, pmstr, len, pmstr);
+ (int)len, pmstr, (int)len, pmstr);
}
}
return ck_fun(o);