_60 & _04 - Add WRITE & CLOSE to TIEHANDLE

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

diff --git a/pp_ctl.c b/pp_ctl.c
index a4135c6..9753fcf 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1011,7 +1011,7 @@ dounwind(I32 cxix)
     while (cxstack_ix > cxix) {
        cx = &cxstack[cxstack_ix];
        DEBUG_l(PerlIO_printf(Perl_debug_log, "Unwinding block %ld, type %s\n",
-                             (long) cxstack_ix+1, block_type[cx->cx_type]));
+                             (long) cxstack_ix, block_type[cx->cx_type]));
        /* Note: we don't need to restore the base context info till the end. */
        switch (cx->cx_type) {
        case CXt_SUBST:
@@ -1347,8 +1347,9 @@ PP(pp_enteriter)
        SAVESPTR(*svp);
     }
     else {
-       svp = &GvSV((GV*)POPs);                 /* symbol table variable */
-       SAVESPTR(*svp);
+       GV *gv = (GV*)POPs;
+       (void)save_scalar(gv);
+       svp = &GvSV(gv);                        /* symbol table variable */
     }
 
     ENTER;
@@ -1721,8 +1722,11 @@ PP(pp_goto)
            if (cxix < cxstack_ix)
                dounwind(cxix);
            TOPBLOCK(cx);
+           if (cx->cx_type == CXt_EVAL && cx->blk_eval.old_op_type == OP_ENTEREVAL) 
+               DIE("Can't goto subroutine from an eval-string");
            mark = stack_sp;
-           if (cx->blk_sub.hasargs) {   /* put @_ back onto stack */
+           if (cx->cx_type == CXt_SUB &&
+               cx->blk_sub.hasargs) {   /* put @_ back onto stack */
                AV* av = cx->blk_sub.argarray;
                
                items = AvFILLp(av) + 1;
@@ -1737,7 +1741,8 @@ PP(pp_goto)
                AvREAL_off(av);
                av_clear(av);
            }
-           if (!(CvDEPTH(cx->blk_sub.cv) = cx->blk_sub.olddepth))
+           if (cx->cx_type == CXt_SUB &&
+               !(CvDEPTH(cx->blk_sub.cv) = cx->blk_sub.olddepth))
                SvREFCNT_dec(cx->blk_sub.cv);
            oldsave = scopestack[scopestack_ix - 1];
            LEAVE_SCOPE(oldsave);
@@ -1767,6 +1772,12 @@ PP(pp_goto)
            else {
                AV* padlist = CvPADLIST(cv);
                SV** svp = AvARRAY(padlist);
+               if (cx->cx_type == CXt_EVAL) {
+                   in_eval = cx->blk_eval.old_in_eval;
+                   eval_root = cx->blk_eval.old_eval_root;
+                   cx->cx_type = CXt_SUB;
+                   cx->blk_sub.hasargs = 0;
+               }
                cx->blk_sub.cv = cv;
                cx->blk_sub.olddepth = CvDEPTH(cv);
                CvDEPTH(cv)++;
@@ -2347,6 +2358,7 @@ PP(pp_require)
     register PERL_CONTEXT *cx;
     SV *sv;
     char *name;
+    STRLEN len;
     char *tryname;
     SV *namesv = Nullsv;
     SV** svp;
@@ -2361,12 +2373,12 @@ PP(pp_require)
                SvPV(sv,na),patchlevel);
        RETPUSHYES;
     }
-    name = SvPV(sv, na);
-    if (!*name)
+    name = SvPV(sv, len);
+    if (!(name && len > 0 && *name))
        DIE("Null filename used");
     TAINT_PROPER("require");
     if (op->op_type == OP_REQUIRE &&
-      (svp = hv_fetch(GvHVn(incgv), name, SvCUR(sv), 0)) &&
+      (svp = hv_fetch(GvHVn(incgv), name, len, 0)) &&
       *svp != &sv_undef)
        RETPUSHYES;
 
@@ -2628,6 +2640,7 @@ PP(pp_leaveeval)
     assert(CvDEPTH(compcv) == 1);
 #endif
     CvDEPTH(compcv) = 0;
+    lex_end();
 
     if (optype == OP_REQUIRE &&
        !(gimme == G_SCALAR ? SvTRUE(*sp) : sp > newsp))
@@ -2636,13 +2649,13 @@ PP(pp_leaveeval)
        char *name = cx->blk_eval.old_name;
        (void)hv_delete(GvHVn(incgv), name, strlen(name), G_DISCARD);
        retop = die("%s did not return a true value", name);
+       /* die_where() did LEAVE, or we won't be here */
+    }
+    else {
+       LEAVE;
+       if (!(save_flags & OPf_SPECIAL))
+           sv_setpv(ERRSV,"");
     }
-
-    lex_end();
-    LEAVE;
-
-    if (!(save_flags & OPf_SPECIAL))
-       sv_setpv(ERRSV,"");
 
     RETURNOP(retop);
 }