Removed the ifdefs for INCOMPLETE_TAINTS

[perl5.git] / pp_ctl.c

diff --git a/pp_ctl.c b/pp_ctl.c
index 4ce8ddb..f258976 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -168,12 +168,10 @@ PP(pp_regcomp)
     }
 
 
-#ifndef INCOMPLETE_TAINTS
     if (TAINTING_get && TAINT_get) {
        SvTAINTED_on((SV*)new_re);
         RX_TAINT_on(new_re);
     }
-#endif
 
 #if !defined(USE_ITHREADS)
     /* can't change the optree at runtime either */
@@ -2616,7 +2614,6 @@ PP(pp_last)
 
     POPBLOCK(cx,newpm);
     cxstack_ix++; /* temporarily protect top context */
-    mark = newsp;
     switch (CxTYPE(cx)) {
     case CXt_LOOP_LAZYIV:
     case CXt_LOOP_LAZYSV:
@@ -2643,8 +2640,7 @@ PP(pp_last)
     }
 
     TAINT_NOT;
-    PL_stack_sp = adjust_stack_on_leave(newsp, PL_stack_sp, MARK, gimme,
-                               pop2 == CXt_SUB ? SVs_TEMP : 0);
+    PL_stack_sp = newsp;
 
     LEAVE;
     cxstack_ix--;
@@ -2776,7 +2772,7 @@ S_dofindlabel(pTHX_ OP *o, const char *label, STRLEN len, U32 flags, OP **opstac
     return 0;
 }
 
-PP(pp_goto)
+PP(pp_goto) /* also pp_dump */
 {
     dVAR; dSP;
     OP *retop = NULL;
@@ -2791,6 +2787,8 @@ PP(pp_goto)
     static const char* const must_have_label = "goto must have label";
 
     if (PL_op->op_flags & OPf_STACKED) {
+        /* goto EXPR  or  goto &foo */
+
        SV * const sv = POPs;
        SvGETMAGIC(sv);
 
@@ -2893,22 +2891,35 @@ PP(pp_goto)
                OP* const retop = cx->blk_sub.retop;
                SV **newsp;
                I32 gimme;
-               const SSize_t items = AvFILLp(arg) + 1;
+               const SSize_t items = arg ? AvFILL(arg) + 1 : 0;
+               const bool m = arg ? cBOOL(SvRMAGICAL(arg)) : 0;
                SV** mark;
 
                 PERL_UNUSED_VAR(newsp);
                 PERL_UNUSED_VAR(gimme);
 
                /* put GvAV(defgv) back onto stack */
-               EXTEND(SP, items+1); /* @_ could have been extended. */
-               Copy(AvARRAY(arg), SP + 1, items, SV*);
+               if (items) {
+                   EXTEND(SP, items+1); /* @_ could have been extended. */
+               }
                mark = SP;
-               SP += items;
-               if (AvREAL(arg)) {
-                   I32 index;
+               if (items) {
+                   SSize_t index;
+                   bool r = cBOOL(AvREAL(arg));
                    for (index=0; index<items; index++)
-                       SvREFCNT_inc_void(sv_2mortal(SP[-index]));
+                   {
+                       SV *sv;
+                       if (m) {
+                           SV ** const svp = av_fetch(arg, index, 0);
+                           sv = svp ? *svp : NULL;
+                       }
+                       else sv = AvARRAY(arg)[index];
+                       SP[index+1] = sv
+                           ? r ? SvREFCNT_inc_NN(sv_2mortal(sv)) : sv
+                           : sv_2mortal(newSVavdefelem(arg, index, 1));
+                   }
                }
+               SP += items;
                SvREFCNT_dec(arg);
                if (CxTYPE(cx) == CXt_SUB && CxHASARGS(cx)) {
                    /* Restore old @_ */
@@ -2981,11 +2992,13 @@ PP(pp_goto)
            }
        }
        else {
+            /* goto EXPR */
            label       = SvPV_nomg_const(sv, label_len);
             label_flags = SvUTF8(sv);
        }
     }
     else if (!(PL_op->op_flags & OPf_SPECIAL)) {
+        /* goto LABEL  or  dump LABEL */
        label       = cPVOP->op_pv;
         label_flags = (cPVOP->op_private & OPpPV_IS_UTF8) ? SVf_UTF8 : 0;
         label_len   = strlen(label);
@@ -3586,7 +3599,8 @@ STATIC PerlIO *
 S_check_type_and_open(pTHX_ SV *name)
 {
     Stat_t st;
-    const char *p = SvPV_nolen_const(name);
+    STRLEN len;
+    const char *p = SvPV_const(name, len);
     int st_rc;
 
     PERL_ARGS_ASSERT_CHECK_TYPE_AND_OPEN;
@@ -3597,7 +3611,7 @@ S_check_type_and_open(pTHX_ SV *name)
      * rather than for the .pm file.
      * This check prevents a \0 in @INC causing problems.
      */
-    if (!IS_SAFE_PATHNAME(name, "require"))
+    if (!IS_SAFE_PATHNAME(p, len, "require"))
         return NULL;
 
     st_rc = PerlLIO_stat(p, &st);
@@ -3626,7 +3640,7 @@ S_doopen_pm(pTHX_ SV *name)
      * warning referring to the .pmc which the user probably doesn't
      * know or care about
      */
-    if (!IS_SAFE_PATHNAME(name, "require"))
+    if (!IS_SAFE_PATHNAME(p, namelen, "require"))
         return NULL;
 
     if (namelen > 3 && memEQs(p + namelen - 3, 3, ".pm")) {
@@ -3761,7 +3775,7 @@ PP(pp_require)
     name = SvPV_const(sv, len);
     if (!(name && len > 0 && *name))
        DIE(aTHX_ "Null filename used");
-    if (!IS_SAFE_PATHNAME(sv, "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),
                       SvCUR(sv)*2,NULL, SvUTF8(sv)?PERL_PV_ESCAPE_UNI:0),
@@ -3913,10 +3927,16 @@ PP(pp_require)
                        SP--;
                    }
 
+                   /* FREETMPS may free our filter_cache */
+                   SvREFCNT_inc_simple_void(filter_cache);
+
                    PUTBACK;
                    FREETMPS;
                    LEAVE_with_name("call_INC");
 
+                   /* Now re-mortalize it. */
+                   sv_2mortal(filter_cache);
+
                    /* Adjust file name if the hook has set an %INC entry.
                       This needs to happen after the FREETMPS above.  */
                    svp = hv_fetch(GvHVn(PL_incgv), name, len, 0);
@@ -3951,6 +3971,8 @@ PP(pp_require)
                        dirlen = 0;
                    }
 
+                   if (!IS_SAFE_SYSCALL(dir, dirlen, "@INC entry", "require"))
+                       continue;
 #ifdef VMS
                    if (((unixdirbuf = SvPVX(sv_2mortal(newSVpv("", VMS_MAXRSS-1)))) == NULL)
                        || ((unixdir = tounixpath(dir, unixdirbuf)) == NULL))