Retract #10070, not ready yet.

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

diff --git a/pp_ctl.c b/pp_ctl.c
index 8466d45..3cda644 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -164,7 +164,7 @@ PP(pp_substcont)
     register char *m = cx->sb_m;
     char *orig = cx->sb_orig;
     register REGEXP *rx = cx->sb_rx;
-    
+
     rxres_restore(&cx->sb_rxres, rx);
 
     if (cx->sb_iters++) {
@@ -551,7 +551,13 @@ PP(pp_formline)
            if (item_is_utf) {
                while (arg--) {
                    if (UTF8_IS_CONTINUED(*s)) {
-                       switch (UTF8SKIP(s)) {
+                       STRLEN skip = UTF8SKIP(s);
+                       switch (skip) {
+                       default:
+                           Move(s,t,skip,char);
+                           s += skip;
+                           t += skip;
+                           break;
                        case 7: *t++ = *s++;
                        case 6: *t++ = *s++;
                        case 5: *t++ = *s++;
@@ -1380,41 +1386,6 @@ Perl_dounwind(pTHX_ I32 cxix)
     }
 }
 
-/*
- * Closures mentioned at top level of eval cannot be referenced
- * again, and their presence indirectly causes a memory leak.
- * (Note that the fact that compcv and friends are still set here
- * is, AFAIK, an accident.)  --Chip
- *
- * XXX need to get comppad et al from eval's cv rather than
- * relying on the incidental global values.
- */
-STATIC void
-S_free_closures(pTHX)
-{
-    SV **svp = AvARRAY(PL_comppad_name);
-    I32 ix;
-    for (ix = AvFILLp(PL_comppad_name); ix >= 0; ix--) {
-       SV *sv = svp[ix];
-       if (sv && sv != &PL_sv_undef && *SvPVX(sv) == '&') {
-           SvREFCNT_dec(sv);
-           svp[ix] = &PL_sv_undef;
-
-           sv = PL_curpad[ix];
-           if (CvCLONE(sv)) {
-               SvREFCNT_dec(CvOUTSIDE(sv));
-               CvOUTSIDE(sv) = Nullcv;
-           }
-           else {
-               SvREFCNT_dec(sv);
-               sv = NEWSV(0,0);
-               SvPADTMP_on(sv);
-               PL_curpad[ix] = sv;
-           }
-       }
-    }
-}
-
 void
 Perl_qerror(pTHX_ SV *err)
 {
@@ -1743,7 +1714,8 @@ PP(pp_dbstate)
        if (!cv)
            DIE(aTHX_ "No DB::DB routine defined");
 
-       if (CvDEPTH(cv) >= 1 && !(PL_debug & (1<<30))) /* don't do recursive DB::DB call */
+       if (CvDEPTH(cv) >= 1 && !(PL_debug & DEBUG_DB_RECURSE_FLAG))
+           /* don't do recursive DB::DB call */
            return NORMAL;
 
        ENTER;
@@ -1950,8 +1922,6 @@ PP(pp_return)
        POPEVAL(cx);
        if (CxTRYBLOCK(cx))
            break;
-       if (AvFILLp(PL_comppad_name) >= 0)
-           free_closures();
        lex_end();
        if (optype == OP_REQUIRE &&
            (MARK == SP || (gimme == G_SCALAR && !SvTRUE(*SP))) )
@@ -2259,7 +2229,7 @@ PP(pp_goto)
            if (cxix < cxstack_ix)
                dounwind(cxix);
            TOPBLOCK(cx);
-           if (CxTYPE(cx) == CXt_EVAL && cx->blk_eval.old_op_type == OP_ENTEREVAL)
+           if (CxREALEVAL(cx))
                DIE(aTHX_ "Can't goto subroutine from an eval-string");
            mark = PL_stack_sp;
            if (CxTYPE(cx) == CXt_SUB && cx->blk_sub.hasargs) {
@@ -2490,6 +2460,8 @@ PP(pp_goto)
 
     if (label && *label) {
        OP *gotoprobe = 0;
+       bool leaving_eval = FALSE;
+        PERL_CONTEXT *last_eval_cx = 0;
 
        /* find label */
 
@@ -2499,8 +2471,15 @@ PP(pp_goto)
            cx = &cxstack[ix];
            switch (CxTYPE(cx)) {
            case CXt_EVAL:
-               gotoprobe = PL_eval_root; /* XXX not good for nested eval */
-               break;
+               leaving_eval = TRUE;
+                if (CxREALEVAL(cx)) {
+                   gotoprobe = (last_eval_cx ?
+                               last_eval_cx->blk_eval.old_eval_root :
+                               PL_eval_root);
+                   last_eval_cx = cx;
+                   break;
+                }
+                /* else fall through */
            case CXt_LOOP:
                gotoprobe = cx->blk_oldcop->op_sibling;
                break;
@@ -2538,6 +2517,17 @@ PP(pp_goto)
        if (!retop)
            DIE(aTHX_ "Can't find label %s", label);
 
+       /* if we're leaving an eval, check before we pop any frames
+           that we're not going to punt, otherwise the error
+          won't be caught */
+
+       if (leaving_eval && *enterops && enterops[1]) {
+           I32 i;
+            for (i = 1; enterops[i]; i++)
+                if (enterops[i]->op_type == OP_ENTERITER)
+                    DIE(aTHX_ "Can't \"goto\" into the middle of a foreach loop");
+       }
+
        /* pop unwanted frames */
 
        if (ix < cxstack_ix) {
@@ -2876,7 +2866,7 @@ S_doeval(pTHX_ int gimme, OP** startop)
        CvOUTSIDE(PL_compcv) = (CV*)SvREFCNT_inc(caller);
     }
 
-    SAVEFREESV(PL_compcv);
+    SAVEMORTALIZESV(PL_compcv);        /* must remain until end of current statement */
 
     /* make sure we compile in the right package */
 
@@ -3032,7 +3022,7 @@ PP(pp_require)
     char *tryname;
     SV *namesv = Nullsv;
     SV** svp;
-    I32 gimme = G_SCALAR;
+    I32 gimme = GIMME_V;
     PerlIO *tryrsfp = 0;
     STRLEN n_a;
     int filter_has_file = 0;
@@ -3048,13 +3038,13 @@ PP(pp_require)
            U8 *s = (U8*)SvPVX(sv);
            U8 *end = (U8*)SvPVX(sv) + SvCUR(sv);
            if (s < end) {
-               rev = utf8_to_uv(s, end - s, &len, 0);
+               rev = utf8n_to_uvchr(s, end - s, &len, 0);
                s += len;
                if (s < end) {
-                   ver = utf8_to_uv(s, end - s, &len, 0);
+                   ver = utf8n_to_uvchr(s, end - s, &len, 0);
                    s += len;
                    if (s < end)
-                       sver = utf8_to_uv(s, end - s, &len, 0);
+                       sver = utf8n_to_uvchr(s, end - s, &len, 0);
                }
            }
            if (PERL_REVISION < rev
@@ -3370,7 +3360,7 @@ trylocal: {
     PL_eval_owner = thr;
     MUTEX_UNLOCK(&PL_eval_mutex);
 #endif /* USE_THREADS */
-    return DOCATCH(doeval(G_SCALAR, NULL));
+    return DOCATCH(doeval(gimme, NULL));
 }
 
 PP(pp_dofile)
@@ -3506,9 +3496,6 @@ PP(pp_leaveeval)
     }
     PL_curpm = newpm;  /* Don't pop $1 et al till now */
 
-    if (AvFILLp(PL_comppad_name) >= 0)
-       free_closures();
-
 #ifdef DEBUGGING
     assert(CvDEPTH(PL_compcv) == 1);
 #endif
@@ -3545,7 +3532,6 @@ PP(pp_entertry)
     push_return(cLOGOP->op_other->op_next);
     PUSHBLOCK(cx, (CXt_EVAL|CXp_TRYBLOCK), SP);
     PUSHEVAL(cx, 0, 0);
-    PL_eval_root = PL_op;              /* Only needed so that goto works right. */
 
     PL_in_eval = EVAL_INEVAL;
     sv_setpv(ERRSV,"");