Explicit ENTER/LEAVE block for upg_version

[perl5.git] / pp_ctl.c

diff --git a/pp_ctl.c b/pp_ctl.c
index 95727f2..2b7b3a9 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -836,10 +836,13 @@ 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;
@@ -1696,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
@@ -3236,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
 */
@@ -3592,7 +3595,7 @@ S_check_type_and_open(pTHX_ SV *name)
        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);
@@ -3668,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;
@@ -3765,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;
     }
@@ -3807,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",
@@ -3829,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
@@ -3937,7 +3950,7 @@ PP(pp_require)
                    STRLEN dirlen;
 
                    if (SvOK(dirsv)) {
-                       dir = SvPV_const(dirsv, dirlen);
+                       dir = SvPV_nomg_const(dirsv, dirlen);
                    } else {
                        dir = "";
                        dirlen = 0;
@@ -3946,8 +3959,9 @@ PP(pp_require)
                    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);