This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Explicit ENTER/LEAVE block for upg_version
[perl5.git] / pp_ctl.c
index 47d8a1f..2b7b3a9 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 */
@@ -468,7 +466,8 @@ PP(pp_formline)
     I32 arg;
     SV *sv = NULL; /* current item */
     const char *item = NULL;/* string value of current item */
-    I32 itemsize  = 0;     /* length of current item, possibly truncated */
+    I32 itemsize  = 0;     /* length (chars) of item, possibly truncated */
+    I32 itembytes = 0;     /* as itemsize, but length in bytes */
     I32 fieldsize = 0;     /* width of current field */
     I32 lines = 0;         /* number of lines that have been output */
     bool chopspace = (strchr(PL_chopset, ' ') != NULL); /* does $: have space */
@@ -476,7 +475,7 @@ PP(pp_formline)
     STRLEN linemark = 0;    /* pos of start of line in output */
     NV value;
     bool gotsome = FALSE;   /* seen at least one non-blank item on this line */
-    STRLEN len;
+    STRLEN len;             /* length of current sv */
     STRLEN linemax;        /* estimate of output size in bytes */
     bool item_is_utf8 = FALSE;
     bool targ_is_utf8 = FALSE;
@@ -536,13 +535,13 @@ PP(pp_formline)
                PerlIO_printf(Perl_debug_log, "%-16s\n", name);
        } );
        switch (*fpc++) {
-       case FF_LINEMARK:
+       case FF_LINEMARK: /* start (or end) of a line */
            linemark = t - SvPVX(PL_formtarget);
            lines++;
            gotsome = FALSE;
            break;
 
-       case FF_LITERAL:
+       case FF_LITERAL: /* append <arg> literal chars */
            to_copy = *fpc++;
            source = (U8 *)f;
            f += to_copy;
@@ -550,11 +549,11 @@ PP(pp_formline)
            item_is_utf8 = targ_is_utf8 ? !!DO_UTF8(formsv) : !!SvUTF8(formsv);
            goto append;
 
-       case FF_SKIP:
+       case FF_SKIP: /* skip <arg> chars in format */
            f += *fpc++;
            break;
 
-       case FF_FETCH:
+       case FF_FETCH: /* get next item and set field size to <arg> */
            arg = *fpc++;
            f += arg;
            fieldsize = arg;
@@ -569,139 +568,91 @@ PP(pp_formline)
                SvTAINTED_on(PL_formtarget);
            break;
 
-       case FF_CHECKNL:
+       case FF_CHECKNL: /* find max len of item (up to \n) that fits field */
            {
-               const char *send;
                const char *s = item = SvPV_const(sv, len);
-               itemsize = len;
-               if (DO_UTF8(sv)) {
-                   itemsize = sv_len_utf8(sv);
-                   if (itemsize != (I32)len) {
-                       I32 itembytes;
-                       if (itemsize > fieldsize) {
-                           itemsize = fieldsize;
-                           itembytes = itemsize;
-                           sv_pos_u2b(sv, &itembytes, 0);
-                       }
-                       else
-                           itembytes = len;
-                       send = chophere = s + itembytes;
-                       while (s < send) {
-                           if (! isCNTRL(*s))
-                               gotsome = TRUE;
-                           else if (*s == '\n')
-                               break;
-                           s++;
-                       }
-                       item_is_utf8 = TRUE;
-                       itemsize = s - item;
-                       sv_pos_b2u(sv, &itemsize);
-                       break;
-                   }
-               }
-               item_is_utf8 = FALSE;
-               if (itemsize > fieldsize)
-                   itemsize = fieldsize;
-               send = chophere = s + itemsize;
-               while (s < send) {
-                   if (! isCNTRL(*s))
-                       gotsome = TRUE;
-                   else if (*s == '\n')
-                       break;
-                   s++;
-               }
-               itemsize = s - item;
+               const char *send = s + len;
+
+                itemsize = 0;
+               item_is_utf8 = DO_UTF8(sv);
+                while (s < send) {
+                    if (!isCNTRL(*s))
+                        gotsome = TRUE;
+                    else if (*s == '\n')
+                        break;
+
+                    if (item_is_utf8)
+                        s += UTF8SKIP(s);
+                    else
+                        s++;
+                    itemsize++;
+                    if (itemsize == fieldsize)
+                        break;
+                }
+                itembytes = s - item;
                break;
            }
 
-       case FF_CHECKCHOP:
+       case FF_CHECKCHOP: /* like CHECKNL, but up to highest split point */
            {
                const char *s = item = SvPV_const(sv, len);
-               itemsize = len;
-               if (DO_UTF8(sv)) {
-                   itemsize = sv_len_utf8(sv);
-                   if (itemsize != (I32)len) {
-                       I32 itembytes;
-                       if (itemsize <= fieldsize) {
-                           const char *send = chophere = s + itemsize;
-                           while (s < send) {
-                               if (*s == '\r') {
-                                   itemsize = s - item;
-                                   chophere = s;
-                                   break;
-                               }
-                               if (! isCNTRL(*s))
-                                   gotsome = TRUE;
-                                s++;
-                           }
-                       }
-                       else {
-                           const char *send;
-                           itemsize = fieldsize;
-                           itembytes = itemsize;
-                           sv_pos_u2b(sv, &itembytes, 0);
-                           send = chophere = s + itembytes;
-                           while (s < send || (s == send && isSPACE(*s))) {
-                               if (isSPACE(*s)) {
-                                   if (chopspace)
-                                       chophere = s;
-                                   if (*s == '\r')
-                                       break;
-                               }
-                               else {
-                                   if (! isCNTRL(*s))
-                                       gotsome = TRUE;
-                                   if (strchr(PL_chopset, *s))
-                                       chophere = s + 1;
-                               }
-                               s++;
-                           }
-                           itemsize = chophere - item;
-                           sv_pos_b2u(sv, &itemsize);
-                       }
-                       item_is_utf8 = TRUE;
-                       break;
-                   }
-               }
-               item_is_utf8 = FALSE;
-               if (itemsize <= fieldsize) {
-                   const char *const send = chophere = s + itemsize;
-                   while (s < send) {
-                       if (*s == '\r') {
-                           itemsize = s - item;
-                           chophere = s;
-                           break;
-                       }
-                       if (! isCNTRL(*s))
-                           gotsome = TRUE;
+               const char *send = s + len;
+                I32 size = 0;
+
+                chophere = NULL;
+               item_is_utf8 = DO_UTF8(sv);
+                while (s < send) {
+                    /* look for a legal split position */
+                    if (isSPACE(*s)) {
+                        if (*s == '\r') {
+                            chophere = s;
+                            itemsize = size;
+                            break;
+                        }
+                        if (chopspace) {
+                            /* provisional split point */
+                            chophere = s;
+                            itemsize = size;
+                        }
+                        /* we delay testing fieldsize until after we've
+                         * processed the possible split char directly
+                         * following the last field char; so if fieldsize=3
+                         * and item="a b cdef", we consume "a b", not "a".
+                         * Ditto further down.
+                         */
+                        if (size == fieldsize)
+                            break;
+                    }
+                    else {
+                        if (strchr(PL_chopset, *s)) {
+                            /* provisional split point */
+                            /* for a non-space split char, we include
+                             * the split char; hence the '+1' */
+                            chophere = s + 1;
+                            itemsize = size;
+                        }
+                        if (size == fieldsize)
+                            break;
+                        if (!isCNTRL(*s))
+                            gotsome = TRUE;
+                    }
+
+                    if (item_is_utf8)
+                        s += UTF8SKIP(s);
+                    else
                         s++;
-                   }
-               }
-               else {
-                   const char *send;
-                   itemsize = fieldsize;
-                   send = chophere = s + itemsize;
-                   while (s < send || (s == send && isSPACE(*s))) {
-                       if (isSPACE(*s)) {
-                           if (chopspace)
-                               chophere = s;
-                           if (*s == '\r')
-                               break;
-                       }
-                       else {
-                           if (! isCNTRL(*s))
-                               gotsome = TRUE;
-                           if (strchr(PL_chopset, *s))
-                               chophere = s + 1;
-                       }
-                       s++;
-                   }
-                   itemsize = chophere - item;
-               }
+                    size++;
+                }
+                if (!chophere || s == send) {
+                    chophere = s;
+                    itemsize = size;
+                }
+                itembytes = chophere - item;
+
                break;
            }
 
-       case FF_SPACE:
+       case FF_SPACE: /* append padding space (diff of field, item size) */
            arg = fieldsize - itemsize;
            if (arg) {
                fieldsize -= arg;
@@ -710,7 +661,7 @@ PP(pp_formline)
            }
            break;
 
-       case FF_HALFSPACE:
+       case FF_HALFSPACE: /* like FF_SPACE, but only append half as many */
            arg = fieldsize - itemsize;
            if (arg) {
                arg /= 2;
@@ -720,34 +671,33 @@ PP(pp_formline)
            }
            break;
 
-       case FF_ITEM:
-           to_copy = itemsize;
+       case FF_ITEM: /* append a text item, while blanking ctrl chars */
+           to_copy = itembytes;
            source = (U8 *)item;
            trans = 1;
-           if (item_is_utf8) {
-               /* convert to_copy from chars to bytes */
-               U8 *s = source;
-               while (to_copy--)
-                  s += UTF8SKIP(s);
-               to_copy = s - source;
-           }
            goto append;
 
-       case FF_CHOP:
+       case FF_CHOP: /* (for ^*) chop the current item */
            {
                const char *s = chophere;
                if (chopspace) {
                    while (isSPACE(*s))
                        s++;
                }
-               sv_chop(sv,s);
+                if (SvPOKp(sv))
+                    sv_chop(sv,s);
+                else
+                    /* tied, overloaded or similar strangeness.
+                     * Do it the hard way */
+                    sv_setpvn(sv, s, len - (s-item));
                SvSETMAGIC(sv);
                break;
            }
 
-       case FF_LINESNGL:
+       case FF_LINESNGL: /* process ^*  */
            chopspace = 0;
-       case FF_LINEGLOB:
+
+       case FF_LINEGLOB: /* process @*  */
            {
                const bool oneline = fpc[-1] == FF_LINESNGL;
                const char *s = item = SvPV_const(sv, len);
@@ -764,7 +714,7 @@ PP(pp_formline)
                while (s < send) {
                    if (*s++ == '\n') {
                        if (oneline) {
-                           to_copy = s - SvPVX_const(sv) - 1;
+                           to_copy = s - item - 1;
                            chophere = s;
                            break;
                        } else {
@@ -844,7 +794,7 @@ PP(pp_formline)
                break;
            }
 
-       case FF_0DECIMAL:
+       case FF_0DECIMAL: /* like FF_DECIMAL but for 0### */
            arg = *fpc++;
 #if defined(USE_LONG_DOUBLE)
            fmt = (const char *)
@@ -856,7 +806,8 @@ PP(pp_formline)
                 "%#0*.*f"              : "%0*.*f");
 #endif
            goto ff_dec;
-       case FF_DECIMAL:
+
+       case FF_DECIMAL: /* do @##, ^##, where <arg>=(precision|flags) */
            arg = *fpc++;
 #if defined(USE_LONG_DOUBLE)
            fmt = (const char *)
@@ -885,22 +836,25 @@ PP(pp_formline)
            }
            /* Formats aren't yet marked for locales, so assume "yes". */
            {
-               STORE_NUMERIC_STANDARD_SET_LOCAL();
+                DECLARE_STORE_LC_NUMERIC_SET_TO_NEEDED();
                arg &= ~(FORM_NUM_POINT|FORM_NUM_BLANK);
+                /* we generate fmt ourselves so it is safe */
+                GCC_DIAG_IGNORE(-Wformat-nonliteral);
                my_snprintf(t, SvLEN(PL_formtarget) - (t - SvPVX(PL_formtarget)), fmt, (int) fieldsize, (int) arg, value);
-               RESTORE_NUMERIC_STANDARD();
+                GCC_DIAG_RESTORE;
+                RESTORE_LC_NUMERIC();
            }
            t += fieldsize;
            break;
 
-       case FF_NEWLINE:
+       case FF_NEWLINE: /* delete trailing spaces, then append \n */
            f++;
            while (t-- > (SvPVX(PL_formtarget) + linemark) && *t == ' ') ;
            t++;
            *t++ = '\n';
            break;
 
-       case FF_BLANK:
+       case FF_BLANK: /* for arg==0: do '~'; for arg>0 : do '~~' */
            arg = *fpc++;
            if (gotsome) {
                if (arg) {              /* repeat until fields exhausted? */
@@ -914,7 +868,7 @@ PP(pp_formline)
            }
            break;
 
-       case FF_MORE:
+       case FF_MORE: /* replace long end of string with '...' */
            {
                const char *s = chophere;
                const char *send = item + len;
@@ -941,7 +895,8 @@ PP(pp_formline)
                }
                break;
            }
-       case FF_END:
+
+       case FF_END: /* tidy up, then return */
        end:
            assert(t < SvPVX_const(PL_formtarget) + SvLEN(PL_formtarget));
            *t = '\0';
@@ -1744,17 +1699,17 @@ PP(pp_xor)
 /*
 =for apidoc caller_cx
 
-The XSUB-writer's equivalent of L<caller()|perlfunc/caller>. The
+The XSUB-writer's equivalent of L<caller()|perlfunc/caller>.  The
 returned C<PERL_CONTEXT> structure can be interrogated to find all the
-information returned to Perl by C<caller>. Note that XSUBs don't get a
+information returned to Perl by C<caller>.  Note that XSUBs don't get a
 stack frame, so C<caller_cx(0, NULL)> will return information for the
 immediately-surrounding Perl code.
 
 This function skips over the automatic calls to C<&DB::sub> made on the
-behalf of the debugger. If the stack frame requested was a sub called by
+behalf of the debugger.  If the stack frame requested was a sub called by
 C<DB::sub>, the return value will be the frame for the call to
 C<DB::sub>, since that has the correct line number/etc. for the call
-site. If I<dbcxp> is non-C<NULL>, it will be set to a pointer to the
+site.  If I<dbcxp> is non-C<NULL>, it will be set to a pointer to the
 frame for the sub call itself.
 
 =cut
@@ -2035,8 +1990,13 @@ PP(pp_dbstate)
        return NORMAL;
 }
 
+/* SVs on the stack that have any of the flags passed in are left as is.
+   Other SVs are protected via the mortals stack if lvalue is true, and
+   copied otherwise. */
+
 STATIC SV **
-S_adjust_stack_on_leave(pTHX_ SV **newsp, SV **sp, SV **mark, I32 gimme, U32 flags)
+S_adjust_stack_on_leave(pTHX_ SV **newsp, SV **sp, SV **mark, I32 gimme,
+                             U32 flags, bool lvalue)
 {
     bool padtmp = 0;
     PERL_ARGS_ASSERT_ADJUST_STACK_ON_LEAVE;
@@ -2048,7 +2008,10 @@ S_adjust_stack_on_leave(pTHX_ SV **newsp, SV **sp, SV **mark, I32 gimme, U32 fla
     if (gimme == G_SCALAR) {
        if (MARK < SP)
            *++newsp = ((SvFLAGS(*SP) & flags) || (padtmp && SvPADTMP(*SP)))
-                           ? *SP : sv_mortalcopy(*SP);
+                           ? *SP
+                           : lvalue
+                               ? sv_2mortal(SvREFCNT_inc_simple_NN(*SP))
+                               : sv_mortalcopy(*SP);
        else {
            /* MEXTEND() only updates MARK, so reuse it instead of newsp. */
            MARK = newsp;
@@ -2063,7 +2026,9 @@ S_adjust_stack_on_leave(pTHX_ SV **newsp, SV **sp, SV **mark, I32 gimme, U32 fla
            if ((SvFLAGS(*MARK) & flags) || (padtmp && SvPADTMP(*MARK)))
                *++newsp = *MARK;
            else {
-               *++newsp = sv_mortalcopy(*MARK);
+               *++newsp = lvalue
+                           ? sv_2mortal(SvREFCNT_inc_simple_NN(*MARK))
+                           : sv_mortalcopy(*MARK);
                TAINT_NOT;      /* Each item is independent */
            }
        }
@@ -2106,7 +2071,8 @@ 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);
+    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 */
 
     LEAVE_with_name("block");
@@ -2268,7 +2234,8 @@ PP(pp_leaveloop)
     newsp = PL_stack_base + cx->blk_loop.resetsp;
 
     TAINT_NOT;
-    SP = adjust_stack_on_leave(newsp, SP, MARK, gimme, 0);
+    SP = adjust_stack_on_leave(newsp, SP, MARK, gimme, 0,
+                              PL_op->op_private & OPpLVALUE);
     PUTBACK;
 
     POPLOOP(cx);       /* Stack values are safe: release loop vars ... */
@@ -2609,14 +2576,12 @@ PP(pp_last)
     OP *nextop = NULL;
     SV **newsp;
     PMOP *newpm;
-    SV **mark;
     SV *sv = NULL;
 
     S_unwind_loop(aTHX_ "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 +2608,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--;
@@ -2895,7 +2859,8 @@ PP(pp_goto) /* also pp_dump */
                OP* const retop = cx->blk_sub.retop;
                SV **newsp;
                I32 gimme;
-               const SSize_t items = arg ? AvFILLp(arg) + 1 : 0;
+               const SSize_t items = arg ? AvFILL(arg) + 1 : 0;
+               const bool m = arg ? cBOOL(SvRMAGICAL(arg)) : 0;
                SV** mark;
 
                 PERL_UNUSED_VAR(newsp);
@@ -2904,20 +2869,25 @@ PP(pp_goto) /* also pp_dump */
                /* put GvAV(defgv) back onto stack */
                if (items) {
                    EXTEND(SP, items+1); /* @_ could have been extended. */
-                   Copy(AvARRAY(arg), SP + 1, items, SV*);
                }
                mark = SP;
-               SP += items;
-               if (items && AvREAL(arg)) {
-                   I32 index;
+               if (items) {
+                   SSize_t index;
+                   bool r = cBOOL(AvREAL(arg));
                    for (index=0; index<items; index++)
-                       if (SP[-index])
-                           SvREFCNT_inc_void_NN(sv_2mortal(SP[-index]));
-                       else {
-                           SP[-index] = sv_2mortal(newSVavdefelem(arg,
-                                                AvFILLp(arg) - index, 1));
+                   {
+                       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 @_ */
@@ -3160,9 +3130,11 @@ PP(pp_exit)
     else {
        anum = SvIVx(POPs);
 #ifdef VMS
-        if (anum == 1 && (PL_op->op_private & OPpEXIT_VMSISH))
+       if (anum == 1
+        && SvTRUE(cop_hints_fetch_pvs(PL_curcop, "vmsish_exit", 0)))
            anum = 0;
-        VMSISH_HUSHED  = VMSISH_HUSHED || (PL_op->op_private & OPpHUSH_VMSISH);
+        VMSISH_HUSHED  =
+            VMSISH_HUSHED || (PL_curcop->op_private & OPpHUSH_VMSISH);
 #endif
     }
     PL_exit_flags |= PERL_EXIT_EXPECTED;
@@ -3267,8 +3239,8 @@ S_docatch(pTHX_ OP *o)
 Locate the CV corresponding to the currently executing sub or eval.
 If db_seqp is non_null, skip CVs that are in the DB package and populate
 *db_seqp with the cop sequence number at the point that the DB:: code was
-entered. (allows debuggers to eval in the scope of the breakpoint rather
-than in the scope of the debugger itself).
+entered.  (This allows debuggers to eval in the scope of the breakpoint
+rather than in the scope of the debugger itself.)
 
 =cut
 */
@@ -3597,7 +3569,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;
@@ -3608,16 +3581,21 @@ 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;
 
+    /* we use the value of errno later to see how stat() or open() failed.
+     * We don't want it set if the stat succeeded but we still failed,
+     * such as if the name exists, but is a directory */
+    errno = 0;
+
     st_rc = PerlLIO_stat(p, &st);
 
     if (st_rc < 0 || S_ISDIR(st.st_mode) || S_ISBLK(st.st_mode)) {
        return NULL;
     }
 
-#if !defined(PERLIO_IS_STDIO) && !defined(USE_SFIO)
+#if !defined(PERLIO_IS_STDIO)
     return PerlIO_openn(aTHX_ ":", PERL_SCRIPT_MODE, -1, 0, 0, NULL, 1, &name);
 #else
     return PerlIO_open(p, PERL_SCRIPT_MODE);
@@ -3637,7 +3615,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")) {
@@ -3693,9 +3671,7 @@ PP(pp_require)
     STRLEN unixlen;
 #ifdef VMS
     int vms_unixname = 0;
-    char *unixnamebuf;
     char *unixdir;
-    char *unixdirbuf;
 #endif
     const char *tryname = NULL;
     SV *namesv = NULL;
@@ -3772,7 +3748,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),
@@ -3790,8 +3766,9 @@ PP(pp_require)
      * name can be translated to UNIX.
      */
     
-    if ((unixnamebuf = SvPVX(sv_2mortal(newSVpv("", VMS_MAXRSS-1))))
-        && (unixname = tounixspec(name, unixnamebuf)) != NULL) {
+    if ((unixname =
+         tounixspec(name, SvPVX(sv_2mortal(newSVpv("", VMS_MAXRSS-1)))))
+        != NULL) {
        unixlen = strlen(unixname);
        vms_unixname = 1;
     }
@@ -3832,21 +3809,22 @@ PP(pp_require)
        if (vms_unixname)
 #endif
        {
+           SV *nsv = sv;
            namesv = newSV_type(SVt_PV);
            for (i = 0; i <= AvFILL(ar); i++) {
                SV * const dirsv = *av_fetch(ar, i, TRUE);
 
-               if (SvTIED_mg((const SV *)ar, PERL_MAGIC_tied))
-                   mg_get(dirsv);
+               SvGETMAGIC(dirsv);
                if (SvROK(dirsv)) {
                    int count;
                    SV **svp;
                    SV *loader = dirsv;
 
                    if (SvTYPE(SvRV(loader)) == SVt_PVAV
-                       && !sv_isobject(loader))
+                       && !SvOBJECT(SvRV(loader)))
                    {
                        loader = *av_fetch(MUTABLE_AV(SvRV(loader)), 0, TRUE);
+                       SvGETMAGIC(loader);
                    }
 
                    Perl_sv_setpvf(aTHX_ namesv, "/loader/0x%"UVxf"/%s",
@@ -3854,14 +3832,24 @@ PP(pp_require)
                    tryname = SvPVX_const(namesv);
                    tryrsfp = NULL;
 
+                   if (SvPADTMP(nsv)) {
+                       nsv = sv_newmortal();
+                       SvSetSV_nosteal(nsv,sv);
+                   }
+
                    ENTER_with_name("call_INC");
                    SAVETMPS;
                    EXTEND(SP, 2);
 
                    PUSHMARK(SP);
                    PUSHs(dirsv);
-                   PUSHs(sv);
+                   PUSHs(nsv);
                    PUTBACK;
+                   if (SvGMAGICAL(loader)) {
+                       SV *l = sv_newmortal();
+                       sv_setsv_nomg(l, loader);
+                       loader = l;
+                   }
                    if (sv_isobject(loader))
                        count = call_method("INC", G_ARRAY);
                    else
@@ -3924,10 +3912,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);
@@ -3956,15 +3950,18 @@ PP(pp_require)
                    STRLEN dirlen;
 
                    if (SvOK(dirsv)) {
-                       dir = SvPV_const(dirsv, dirlen);
+                       dir = SvPV_nomg_const(dirsv, dirlen);
                    } else {
                        dir = "";
                        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))
+                   if ((unixdir =
+                         tounixpath(dir, SvPVX(sv_2mortal(newSVpv("", VMS_MAXRSS-1)))))
+                        == NULL)
                        continue;
                    sv_setpv(namesv, unixdir);
                    sv_catpv(namesv, unixname);
@@ -4305,7 +4302,7 @@ PP(pp_leaveeval)
 
     TAINT_NOT;
     SP = adjust_stack_on_leave((gimme == G_VOID) ? SP : newsp, SP, newsp,
-                               gimme, SVs_TEMP);
+                               gimme, SVs_TEMP, FALSE);
     PL_curpm = newpm;  /* Don't pop $1 et al till now */
 
 #ifdef DEBUGGING
@@ -4403,7 +4400,8 @@ PP(pp_leavetry)
     PERL_UNUSED_VAR(optype);
 
     TAINT_NOT;
-    SP = adjust_stack_on_leave(newsp, SP, newsp, gimme, SVs_PADTMP|SVs_TEMP);
+    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 */
 
     LEAVE_with_name("eval_scope");
@@ -4449,7 +4447,8 @@ PP(pp_leavegiven)
     assert(CxTYPE(cx) == CXt_GIVEN);
 
     TAINT_NOT;
-    SP = adjust_stack_on_leave(newsp, SP, newsp, gimme, SVs_PADTMP|SVs_TEMP);
+    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 */
 
     LEAVE_with_name("given");
@@ -5027,7 +5026,8 @@ PP(pp_leavewhen)
     assert(CxTYPE(cx) == CXt_WHEN);
 
     TAINT_NOT;
-    SP = adjust_stack_on_leave(newsp, SP, newsp, gimme, SVs_PADTMP|SVs_TEMP);
+    SP = adjust_stack_on_leave(newsp, SP, newsp, gimme,
+                              SVs_PADTMP|SVs_TEMP, FALSE);
     PL_curpm = newpm;   /* pop $1 et al */
 
     LEAVE_with_name("when");