Ressurect change 27824, which plugs a resource leak in uncalled code.

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

diff --git a/op.c b/op.c
index 75d1850..30231d3 100644 (file)
--- a/op.c
+++ b/op.c
@@ -248,6 +248,7 @@ Perl_allocmy(pTHX_ char *name)
            /* 1999-02-27 mjd@plover.com */
            char *p;
            p = strchr(name, '\0');
+           assert(p);
            /* The next block assumes the buffer is at least 205 chars
               long.  At present, it's always at least 256 chars. */
            if (p - name > 200) {
@@ -276,7 +277,8 @@ Perl_allocmy(pTHX_ char *name)
     if (PL_in_my_stash && *name != '$') {
        yyerror(Perl_form(aTHX_
                    "Can't declare class for non-scalar %s in \"%s\"",
-                    name, is_our ? "our" : "my"));
+                    name,
+                    is_our ? "our" : PL_in_my == KEY_state ? "state" : "my"));
     }
 
     /* allocate a spare slot and store the name in that slot */
@@ -288,7 +290,8 @@ Perl_allocmy(pTHX_ char *name)
                        ? (PL_curstash && !strEQ(name,"$_") ? PL_curstash : PL_defstash)
                        : NULL
                    ),
-                   0 /*  not fake */
+                   0, /*  not fake */
+                   PL_in_my == KEY_state
     );
     return off;
 }
@@ -1793,7 +1796,8 @@ S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp)
               type == OP_RV2HV) { /* XXX does this let anything illegal in? */
        if (cUNOPo->op_first->op_type != OP_GV) { /* MJD 20011224 */
            yyerror(Perl_form(aTHX_ "Can't declare %s in %s",
-                       OP_DESC(o), PL_in_my == KEY_our ? "our" : "my"));
+                       OP_DESC(o),
+                       PL_in_my == KEY_our ? "our" : PL_in_my == KEY_state ? "state" : "my"));
        } else if (attrs) {
            GV * const gv = cGVOPx_gv(cUNOPo->op_first);
            PL_in_my = FALSE;
@@ -1814,7 +1818,7 @@ S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp)
     {
        yyerror(Perl_form(aTHX_ "Can't declare %s in \"%s\"",
                          OP_DESC(o),
-                         PL_in_my == KEY_our ? "our" : "my"));
+                         PL_in_my == KEY_our ? "our" : PL_in_my == KEY_state ? "state" : "my"));
        return o;
     }
     else if (attrs && type != OP_PUSHMARK) {
@@ -1831,6 +1835,8 @@ S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp)
     }
     o->op_flags |= OPf_MOD;
     o->op_private |= OPpLVAL_INTRO;
+    if (PL_in_my == KEY_state)
+       o->op_private |= OPpPAD_STATE;
     return o;
 }
 
@@ -2112,7 +2118,7 @@ Perl_localize(pTHX_ OP *o, I32 lex)
            if (sigil && (*s == ';' || *s == '=')) {
                Perl_warner(aTHX_ packWARN(WARN_PARENTHESIS),
                                "Parentheses missing around \"%s\" list",
-                               lex ? (PL_in_my == KEY_our ? "our" : "my")
+                               lex ? (PL_in_my == KEY_our ? "our" : PL_in_my == KEY_state ? "state" : "my")
                                : "local");
            }
        }
@@ -2222,6 +2228,11 @@ Perl_fold_constants(pTHX_ register OP *o)
            SvTEMP_off(sv);
        }
        break;
+    case 2:
+       /* my_exit() was called; propagate it */
+       JMPENV_POP;
+       JMPENV_JUMP(2);
+       /* NOTREACHED */
     case 3:
        /* Something tried to die.  Abandon constant folding.  */
        /* Pretend the error never happened.  */
@@ -2230,7 +2241,7 @@ Perl_fold_constants(pTHX_ register OP *o)
        break;
     default:
        JMPENV_POP;
-       /* Don't expect 1 (setjmp failed) or 2 (something called my_exit)  */
+       /* Don't expect 1 (setjmp failed) */
        Perl_croak(aTHX_ "panic: fold_constants JMPENV_PUSH returned %d", ret);
     }
 
@@ -6406,6 +6417,7 @@ Perl_ck_fun(pTHX_ OP *o)
                            else if (kid->op_type == OP_AELEM
                                     || kid->op_type == OP_HELEM)
                            {
+                                OP *firstop;
                                 OP *op = ((BINOP*)kid)->op_first;
                                 name = NULL;
                                 if (op) {
@@ -6415,10 +6427,10 @@ Perl_ck_fun(pTHX_ OP *o)
                                           "[]" : "{}";
                                      if (((op->op_type == OP_RV2AV) ||
                                           (op->op_type == OP_RV2HV)) &&
-                                         (op = ((UNOP*)op)->op_first) &&
-                                         (op->op_type == OP_GV)) {
+                                         (firstop = ((UNOP*)op)->op_first) &&
+                                         (firstop->op_type == OP_GV)) {
                                           /* packagevar $a[] or $h{} */
-                                          GV * const gv = cGVOPx_gv(op);
+                                          GV * const gv = cGVOPx_gv(firstop);
                                           if (gv)
                                                tmpstr =
                                                     Perl_newSVpvf(aTHX_
@@ -6802,6 +6814,16 @@ 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))) {
+           o->op_private |= OPpASSIGN_STATE;
+           /* hijacking PADSTALE for uninitialized state variables */
+           SvPADSTALE_on(PAD_SVl(kkid->op_targ));
+       }
+    }
     return o;
 }