state variables shouldn't be shared between anon subs
[p5sagit/p5-mst-13.2.git] / op.c
diff --git a/op.c b/op.c
index 613cc2e..1ebc84c 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;
 }
 
@@ -3424,32 +3432,15 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg)
     pm = (PMOP*)o;
 
     if (expr->op_type == OP_CONST) {
-       STRLEN plen;
        SV * const pat = ((SVOP*)expr)->op_sv;
-       const char *p = SvPV_const(pat, plen);
        U32 pm_flags = pm->op_pmflags & PMf_COMPILETIME;
-       if ((o->op_flags & OPf_SPECIAL) && (plen == 1 && *p == ' ')) {
-           U32 was_readonly = SvREADONLY(pat);
-
-           if (was_readonly) {
-               if (SvFAKE(pat)) {
-                   sv_force_normal_flags(pat, 0);
-                   assert(!SvREADONLY(pat));
-                   was_readonly = 0;
-               } else {
-                   SvREADONLY_off(pat);
-               }
-           }   
 
-           sv_setpvn(pat, "\\s+", 3);
+       if (o->op_flags & OPf_SPECIAL)
+           pm_flags |= RXf_SPLIT;
 
-           SvFLAGS(pat) |= was_readonly;
-
-           p = SvPV_const(pat, plen);
-           pm_flags |= RXf_SKIPWHITE;
-       }
-        if (DO_UTF8(pat))
+       if (DO_UTF8(pat))
            pm_flags |= RXf_UTF8;
+
        PM_SETRE(pm, CALLREGCOMP(pat, pm_flags));
 
 #ifdef PERL_MAD
@@ -3983,12 +3974,14 @@ 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;
        /* Grandfathering $[ assignment here.  Bletch.*/
        /* Only simple assignments like C<< ($[) = 1 >> are allowed */
-       PL_eval_start = (left->op_type == OP_CONST) ? right : 0;
+       PL_eval_start = (left->op_type == OP_CONST) ? right : NULL;
        left = mod(left, OP_AASSIGN);
        if (PL_eval_start)
            PL_eval_start = 0;
@@ -4076,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)) {
@@ -4286,6 +4327,7 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
            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),
@@ -4986,6 +5028,12 @@ void
 Perl_cv_undef(pTHX_ CV *cv)
 {
     dVAR;
+
+    DEBUG_X(PerlIO_printf(Perl_debug_log,
+         "CV undef: cv=0x%"UVxf" comppad=0x%"UVxf"\n",
+           PTR2UV(cv), PTR2UV(PL_comppad))
+    );
+
 #ifdef USE_ITHREADS
     if (CvFILE(cv) && !CvISXSUB(cv)) {
        /* for XSUBs CvFILE point directly to static memory; __FILE__ */
@@ -5112,6 +5160,9 @@ Perl_op_const_sv(pTHX_ const OP *o, CV *cv)
     dVAR;
     SV *sv = NULL;
 
+    if (PL_madskills)
+       return NULL;
+
     if (!o)
        return NULL;
 
@@ -6994,6 +7045,29 @@ Perl_ck_sassign(pTHX_ OP *o)
            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;
+
+           return nullop;
+       }
+    }
     return o;
 }
 
@@ -7992,6 +8066,7 @@ Perl_peep(pTHX_ register OP *o)
        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 */