Porting/Maintainers.pl

[p5sagit/p5-mst-13.2.git] / op.c

diff --git a/op.c b/op.c
index 4cbb5e6..15510b2 100644 (file)
--- a/op.c
+++ b/op.c
@@ -363,10 +363,12 @@ Perl_allocmy(pTHX_ const char *const name)
     {
        /* 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"));
        }
     }
 
@@ -393,6 +395,12 @@ Perl_allocmy(pTHX_ const char *const name)
                    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;
 }
 
@@ -2810,7 +2818,7 @@ Perl_newMADsv(pTHX_ char key, SV* sv)
 }
 
 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);
@@ -3966,6 +3974,8 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
     }
 
     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;
@@ -4059,6 +4069,54 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
                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)) {
@@ -5522,7 +5580,8 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
                           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);
@@ -5637,6 +5696,13 @@ Perl_newCONSTSUB(pTHX_ HV *stash, const char *name, SV *sv)
 
     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);
 
@@ -7007,6 +7073,11 @@ Perl_ck_sassign(pTHX_ OP *o)
            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;
        }
     }