{
/* name[2] is true if strlen(name) > 2 */
if (!isPRINT(name[1]) || strchr("\t\n\r\f", name[1])) {
- yyerror(Perl_form(aTHX_ "Can't use global %c^%c%s in \"my\"",
- name[0], toCTRL(name[1]), name + 2));
+ yyerror(Perl_form(aTHX_ "Can't use global %c^%c%s in \"%s\"",
+ name[0], toCTRL(name[1]), name + 2,
+ PL_parser->in_my == KEY_state ? "state" : "my"));
} else {
- yyerror(Perl_form(aTHX_ "Can't use global %s in \"my\"",name));
+ yyerror(Perl_form(aTHX_ "Can't use global %s in \"%s\"",name,
+ PL_parser->in_my == KEY_state ? "state" : "my"));
}
}
0, /* not fake */
PL_parser->in_my == KEY_state
);
+ /* anon sub prototypes contains state vars should always be cloned,
+ * otherwise the state var would be shared between anon subs */
+
+ if (PL_parser->in_my == KEY_state && CvANON(PL_compcv))
+ CvCLONE_on(PL_compcv);
+
return off;
}
}
MADPROP *
-Perl_newMADPROP(pTHX_ char key, char type, void* val, I32 vlen)
+Perl_newMADPROP(pTHX_ char key, char type, const void* val, I32 vlen)
{
MADPROP *mp;
Newxz(mp, 1, MADPROP);
if (curop == repl
&& !(repl_has_vars
&& (!PM_GETRE(pm)
- || PM_GETRE(pm)->extflags & RXf_EVAL_SEEN)))
+ || RX_EXTFLAGS(PM_GETRE(pm)) & RXf_EVAL_SEEN)))
{
pm->op_pmflags |= PMf_CONST; /* const for long enough */
prepend_elem(o->op_type, scalar(repl), o);
}
if (is_list_assignment(left)) {
+ static const char no_list_state[] = "Initialization of state variables"
+ " in list context currently forbidden";
OP *curop;
PL_modcount = 0;
o->op_private |= OPpASSIGN_COMMON;
}
+ if ((left->op_type == OP_LIST
+ || (left->op_type == OP_NULL && left->op_targ == OP_LIST))) {
+ OP* lop = ((LISTOP*)left)->op_first;
+ while (lop) {
+ if (lop->op_type == OP_PADSV ||
+ lop->op_type == OP_PADAV ||
+ lop->op_type == OP_PADHV ||
+ lop->op_type == OP_PADANY) {
+ if (lop->op_private & OPpPAD_STATE) {
+ if (left->op_private & OPpLVAL_INTRO) {
+ /* Each variable in state($a, $b, $c) = ... */
+ }
+ else {
+ /* Each state variable in
+ (state $a, my $b, our $c, $d, undef) = ... */
+ }
+ yyerror(no_list_state);
+ } else {
+ /* Each my variable in
+ (state $a, my $b, our $c, $d, undef) = ... */
+ }
+ } else {
+ /* Other ops in the list. undef may be interesting in
+ (state $a, undef, state $c) */
+ }
+ 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))
+ {
+ /* All single variable list context state assignments, hence
+ state ($a) = ...
+ (state $a) = ...
+ state @a = ...
+ state (@a) = ...
+ (state @a) = ...
+ state %a = ...
+ state (%a) = ...
+ (state %a) = ...
+ */
+ yyerror(no_list_state);
+ }
+
if (right && right->op_type == OP_SPLIT && !PL_madskills) {
OP* tmpop = ((LISTOP*)right)->op_first;
if (tmpop && (tmpop->op_type == OP_PUSHRE)) {
if ((o2->op_type == OP_PADSV || o2->op_type == OP_PADAV
|| o2->op_type == OP_PADHV)
&& o2->op_private & OPpLVAL_INTRO
+ && !(o2->op_private & OPpPAD_STATE)
&& ckWARN(WARN_DEPRECATED))
{
Perl_warner(aTHX_ packWARN(WARN_DEPRECATED),
looks_like_bool(cLOGOPo->op_first)
&& looks_like_bool(cLOGOPo->op_first->op_sibling));
+ case OP_NULL:
+ return (
+ o->op_flags & OPf_KIDS
+ && looks_like_bool(cUNOPo->op_first));
+
case OP_ENTERSUB:
case OP_NOT: case OP_XOR:
CopFILE(PL_curcop),
(long)PL_subline, (long)CopLINE(PL_curcop));
gv_efullname3(tmpstr, gv, NULL);
- hv_store(GvHV(PL_DBsub), SvPVX_const(tmpstr), SvCUR(tmpstr), sv, 0);
+ (void)hv_store(GvHV(PL_DBsub), SvPVX_const(tmpstr),
+ SvCUR(tmpstr), sv, 0);
hv = GvHVn(db_postponed);
if (HvFILL(hv) > 0 && hv_exists(hv, SvPVX_const(tmpstr), SvCUR(tmpstr))) {
CV * const pcv = GvCV(db_postponed);
ENTER;
+ if (IN_PERL_RUNTIME) {
+ /* at runtime, it's not safe to manipulate PL_curcop: it may be
+ * an op shared between threads. Use a non-shared COP for our
+ * dirty work */
+ SAVEVPTR(PL_curcop);
+ PL_curcop = &PL_compiling;
+ }
SAVECOPLINE(PL_curcop);
CopLINE_set(PL_curcop, PL_parser ? PL_parser->copline : NOLINE);
OP *
Perl_ck_sassign(pTHX_ OP *o)
{
+ dVAR;
OP * const kid = cLISTOPo->op_first;
/* has a disposable target? */
if ((PL_opargs[kid->op_type] & OA_TARGLEX)
return kid;
}
}
+ if (kid->op_sibling) {
+ OP *kkid = kid->op_sibling;
+ if (kkid->op_type == OP_PADSV
+ && (kkid->op_private & OPpLVAL_INTRO)
+ && SvPAD_STATE(*av_fetch(PL_comppad_name, kkid->op_targ, FALSE))) {
+ 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 condop = first->op_next;
+ /* hijacking PADSTALE for uninitialized state variables */
+ SvPADSTALE_on(PAD_SVl(target));
+
+ condop->op_type = OP_ONCE;
+ condop->op_ppaddr = PL_ppaddr[OP_ONCE];
+ condop->op_targ = target;
+ other->op_targ = target;
+
+ /* Because we change the type of the op here, we will skip the
+ assinment binop->op_last = binop->op_first->op_sibling; at the
+ end of Perl_newBINOP(). So need to do it here. */
+ cBINOPo->op_last = cBINOPo->op_first->op_sibling;
+
+ return nullop;
+ }
+ }
return o;
}
SV * const sv = kid->op_sv;
U32 was_readonly = SvREADONLY(sv);
char *s;
+ STRLEN len;
+ const char *end;
if (was_readonly) {
if (SvFAKE(sv)) {
}
}
- for (s = SvPVX(sv); *s; s++) {
+ s = SvPVX(sv);
+ len = SvCUR(sv);
+ end = s + len;
+ for (; s < end; s++) {
if (*s == ':' && s[1] == ':') {
- const STRLEN len = strlen(s+2)+1;
*s = '/';
- Move(s+2, s+1, len, char);
- SvCUR_set(sv, SvCUR(sv) - 1);
+ Move(s+2, s+1, end - s - 1, char);
+ --end;
}
}
+ SvEND_set(sv, end);
sv_catpvs(sv, ".pm");
SvFLAGS(sv) |= was_readonly;
}
if (kid && kid->op_type == OP_MATCH) {
if (ckWARN(WARN_SYNTAX)) {
const REGEXP *re = PM_GETRE(kPMOP);
- const char *pmstr = re ? re->precomp : "STRING";
- const STRLEN len = re ? re->prelen : 6;
+ const char *pmstr = re ? RX_PRECOMP(re) : "STRING";
+ const STRLEN len = re ? RX_PRELEN(re) : 6;
Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
"/%.*s/ should probably be written as \"%.*s\"",
(int)len, pmstr, (int)len, pmstr);
return o;
}
+OP *
+Perl_ck_each(pTHX_ OP *o)
+{
+
+ OP *kid = cLISTOPo->op_first;
+
+ if (kid->op_type == OP_PADAV || kid->op_type == OP_RV2AV) {
+ const unsigned new_type = o->op_type == OP_EACH ? OP_AEACH
+ : o->op_type == OP_KEYS ? OP_AKEYS : OP_AVALUES;
+ o->op_type = new_type;
+ o->op_ppaddr = PL_ppaddr[new_type];
+ }
+ else if (!(kid->op_type == OP_PADHV || kid->op_type == OP_RV2HV
+ || (kid->op_type == OP_CONST && kid->op_private & OPpCONST_BARE)
+ )) {
+ bad_type(1, "hash or array", PL_op_desc[o->op_type], kid);
+ return o;
+ }
+ return ck_fun(o);
+}
+
/* A peephole optimizer. We visit the ops in the order they're to execute.
* See the comments at the top of this file for more details about when
* peep() is called */
case OP_DORASSIGN:
case OP_COND_EXPR:
case OP_RANGE:
+ case OP_ONCE:
while (cLOGOP->op_other->op_type == OP_NULL)
cLOGOP->op_other = cLOGOP->op_other->op_next;
peep(cLOGOP->op_other); /* Recursive calls are not replaced by fptr calls */
UNOP *refgen, *rv2cv;
LISTOP *exlist;
- if ((o->op_flags && OPf_WANT) != OPf_WANT_VOID)
+ if ((o->op_flags & OPf_WANT) != OPf_WANT_VOID)
break;
if ((o->op_private & ~OPpASSIGN_BACKWARDS) != 2)
https://perl5.git.perl.org / perl5.git / blobdiff