factor out TAINT_NOT into S_adjust_stack_on_leave

[perl5.git] / pp_ctl.c

diff --git a/pp_ctl.c b/pp_ctl.c
index b25905d..3337be0 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -793,26 +793,14 @@ PP(pp_formline)
 
        case FF_0DECIMAL: /* like FF_DECIMAL but for 0### */
            arg = *fpc++;
-#if defined(USE_LONG_DOUBLE)
            fmt = (const char *)
-               ((arg & FORM_NUM_POINT) ?
-                "%#0*.*" PERL_PRIfldbl : "%0*.*" PERL_PRIfldbl);
-#else
-           fmt = (const char *)
-               ((arg & FORM_NUM_POINT) ?
-                "%#0*.*f"              : "%0*.*f");
-#endif
+               ((arg & FORM_NUM_POINT) ? "%#0*.*" NVff : "%0*.*" NVff);
            goto ff_dec;
 
        case FF_DECIMAL: /* do @##, ^##, where <arg>=(precision|flags) */
            arg = *fpc++;
-#if defined(USE_LONG_DOUBLE)
            fmt = (const char *)
-               ((arg & FORM_NUM_POINT) ? "%#*.*" PERL_PRIfldbl : "%*.*" PERL_PRIfldbl);
-#else
-            fmt = (const char *)
-               ((arg & FORM_NUM_POINT) ? "%#*.*f"              : "%*.*f");
-#endif
+               ((arg & FORM_NUM_POINT) ? "%#*.*" NVff : "%*.*" NVff);
        ff_dec:
            /* If the field is marked with ^ and the value is undefined,
               blank it out. */
@@ -939,7 +927,6 @@ PP(pp_grepstart)
 
     src = PL_stack_base[*PL_markstack_ptr];
     if (SvPADTMP(src)) {
-        assert(!IS_PADGV(src));
        src = PL_stack_base[*PL_markstack_ptr] = sv_mortalcopy(src);
        PL_tmps_floor++;
     }
@@ -1092,7 +1079,6 @@ PP(pp_mapwhile)
        /* set $_ to the new source item */
        src = PL_stack_base[PL_markstack_ptr[-1]];
        if (SvPADTMP(src)) {
-            assert(!IS_PADGV(src));
             src = sv_mortalcopy(src);
         }
        SvTEMP_off(src);
@@ -1626,7 +1612,9 @@ Perl_die_unwind(pTHX_ SV *msv)
            SV *namesv;
            PERL_CONTEXT *cx;
            SV **newsp;
+#ifdef DEBUGGING
            COP *oldcop;
+#endif
            JMPENV *restartjmpenv;
            OP *restartop;
 
@@ -1643,7 +1631,9 @@ Perl_die_unwind(pTHX_ SV *msv)
            }
            POPEVAL(cx);
            namesv = cx->blk_eval.old_namesv;
+#ifdef DEBUGGING
            oldcop = cx->blk_oldcop;
+#endif
            restartjmpenv = cx->blk_eval.cur_top_env;
            restartop = cx->blk_eval.retop;
 
@@ -1653,13 +1643,8 @@ Perl_die_unwind(pTHX_ SV *msv)
 
            LEAVE;
 
-           /* LEAVE could clobber PL_curcop (see save_re_context())
-            * XXX it might be better to find a way to avoid messing with
-            * PL_curcop in save_re_context() instead, but this is a more
-            * minimal fix --GSAR */
-           PL_curcop = oldcop;
-
            if (optype == OP_REQUIRE) {
+                assert (PL_curcop == oldcop);
                 (void)hv_store(GvHVn(PL_incgv),
                                SvPVX_const(namesv),
                                SvUTF8(namesv) ? -(I32)SvCUR(namesv) : (I32)SvCUR(namesv),
@@ -1819,12 +1804,9 @@ PP(pp_caller)
     if (!has_arg)
        RETURN;
     if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
-       GV * const cvgv = CvGV(dbcx->blk_sub.cv);
        /* So is ccstack[dbcxix]. */
-       if (cvgv && isGV(cvgv)) {
-           SV * const sv = newSV(0);
-           gv_efullname3(sv, cvgv, NULL);
-           mPUSHs(sv);
+       if (CvHASGV(dbcx->blk_sub.cv)) {
+           PUSHs(cv_name(dbcx->blk_sub.cv, 0));
            PUSHs(boolSV(CxHASARGS(cx)));
        }
        else {
@@ -2007,6 +1989,7 @@ S_adjust_stack_on_leave(pTHX_ SV **newsp, SV **sp, SV **mark, I32 gimme,
     bool padtmp = 0;
     PERL_ARGS_ASSERT_ADJUST_STACK_ON_LEAVE;
 
+    TAINT_NOT;
     if (flags & SVs_PADTMP) {
        flags &= ~SVs_PADTMP;
        padtmp = 1;
@@ -2076,7 +2059,6 @@ PP(pp_leave)
 
     gimme = OP_GIMME(PL_op, (cxstack_ix >= 0) ? gimme : G_SCALAR);
 
-    TAINT_NOT;
     SP = adjust_stack_on_leave(newsp, SP, newsp, gimme, SVs_PADTMP|SVs_TEMP,
                               PL_op->op_private & OPpLVALUE);
     PL_curpm = newpm;  /* Don't pop $1 et al till now */
@@ -2239,7 +2221,6 @@ PP(pp_leaveloop)
     mark = newsp;
     newsp = PL_stack_base + cx->blk_loop.resetsp;
 
-    TAINT_NOT;
     SP = adjust_stack_on_leave(newsp, SP, MARK, gimme, 0,
                               PL_op->op_private & OPpLVALUE);
     PUTBACK;
@@ -3035,14 +3016,17 @@ PP(pp_goto) /* also pp_dump */
                break;
            }
            if (gotoprobe) {
+                OP *sibl1, *sibl2;
+
                retop = dofindlabel(gotoprobe, label, label_len, label_flags,
                                    enterops, enterops + GOTO_DEPTH);
                if (retop)
                    break;
-               if (OP_HAS_SIBLING(gotoprobe) &&
-                       OP_SIBLING(gotoprobe)->op_type == OP_UNSTACK &&
-                       OP_HAS_SIBLING(OP_SIBLING(gotoprobe))) {
-                   retop = dofindlabel(OP_SIBLING(OP_SIBLING(gotoprobe)),
+               if ( (sibl1 = OP_SIBLING(gotoprobe)) &&
+                    sibl1->op_type == OP_UNSTACK &&
+                    (sibl2 = OP_SIBLING(sibl1)))
+                {
+                   retop = dofindlabel(sibl2,
                                        label, label_len, label_flags, enterops,
                                        enterops + GOTO_DEPTH);
                    if (retop)
@@ -3677,6 +3661,7 @@ PP(pp_require)
     bool path_searchable;
 
     sv = POPs;
+    SvGETMAGIC(sv);
     if ( (SvNIOKp(sv) || SvVOK(sv)) && PL_op->op_type != OP_DOFILE) {
        sv = sv_2mortal(new_version(sv));
        if (!Perl_sv_derived_from_pvn(aTHX_ PL_patchlevel, STR_WITH_LEN("version"), 0))
@@ -3734,9 +3719,12 @@ PP(pp_require)
 
        RETPUSHYES;
     }
-    name = SvPV_const(sv, len);
+    if (!SvOK(sv))
+        DIE(aTHX_ "Missing or undefined argument to require");
+    name = SvPV_nomg_const(sv, len);
     if (!(name && len > 0 && *name))
-       DIE(aTHX_ "Null filename used");
+        DIE(aTHX_ "Missing or undefined argument to require");
+
     if (!IS_SAFE_PATHNAME(name, len, "require")) {
         DIE(aTHX_ "Can't locate %s:   %s",
             pv_escape(newSVpvs_flags("",SVs_TEMP),SvPVX(sv),SvCUR(sv),
@@ -4291,7 +4279,6 @@ PP(pp_leaveeval)
     retop = cx->blk_eval.retop;
     evalcv = cx->blk_eval.cv;
 
-    TAINT_NOT;
     SP = adjust_stack_on_leave((gimme == G_VOID) ? SP : newsp, SP, newsp,
                                gimme, SVs_TEMP, FALSE);
     PL_curpm = newpm;  /* Don't pop $1 et al till now */
@@ -4389,7 +4376,6 @@ PP(pp_leavetry)
     POPEVAL(cx);
     PERL_UNUSED_VAR(optype);
 
-    TAINT_NOT;
     SP = adjust_stack_on_leave(newsp, SP, newsp, gimme,
                               SVs_PADTMP|SVs_TEMP, FALSE);
     PL_curpm = newpm;  /* Don't pop $1 et al till now */
@@ -4436,7 +4422,6 @@ PP(pp_leavegiven)
     POPBLOCK(cx,newpm);
     assert(CxTYPE(cx) == CXt_GIVEN);
 
-    TAINT_NOT;
     SP = adjust_stack_on_leave(newsp, SP, newsp, gimme,
                               SVs_PADTMP|SVs_TEMP, FALSE);
     PL_curpm = newpm;  /* Don't pop $1 et al till now */
@@ -5010,7 +4995,6 @@ PP(pp_leavewhen)
     POPBLOCK(cx,newpm);
     assert(CxTYPE(cx) == CXt_WHEN);
 
-    TAINT_NOT;
     SP = adjust_stack_on_leave(newsp, SP, newsp, gimme,
                               SVs_PADTMP|SVs_TEMP, FALSE);
     PL_curpm = newpm;   /* pop $1 et al */