wrong setting in canned win32/config.vc64 file

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

diff --git a/mg.c b/mg.c
index ec4dcd3..0722f44 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -485,14 +485,15 @@ Perl_mg_free(pTHX_ SV *sv)
 U32
 Perl_magic_regdata_cnt(pTHX_ SV *sv, MAGIC *mg)
 {
-    register const REGEXP *rx;
     PERL_UNUSED_ARG(sv);
 
-    if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
-       if (mg->mg_obj)         /* @+ */
-           return rx->nparens;
-       else                    /* @- */
-           return rx->lastparen;
+    if (PL_curpm) {
+       register const REGEXP * const rx = PM_GETRE(PL_curpm);
+       if (rx) {
+           return mg->mg_obj
+               ? rx->nparens       /* @+ */
+               : rx->lastparen;    /* @- */
+       }
     }
 
     return (U32)-1;
@@ -501,32 +502,33 @@ Perl_magic_regdata_cnt(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg)
 {
-    register REGEXP *rx;
-
-    if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
-        register const I32 paren = mg->mg_len;
-        register I32 s;
-        register I32 t;
-       if (paren < 0)
-           return 0;
-       if (paren <= (I32)rx->nparens &&
-           (s = rx->startp[paren]) != -1 &&
-           (t = rx->endp[paren]) != -1)
-           {
-                register I32 i;
-               if (mg->mg_obj)         /* @+ */
-                   i = t;
-               else                    /* @- */
-                   i = s;
+    if (PL_curpm) {
+       register const REGEXP * const rx = PM_GETRE(PL_curpm);
+       if (rx) {
+           register const I32 paren = mg->mg_len;
+           register I32 s;
+           register I32 t;
+           if (paren < 0)
+               return 0;
+           if (paren <= (I32)rx->nparens &&
+               (s = rx->startp[paren]) != -1 &&
+               (t = rx->endp[paren]) != -1)
+               {
+                   register I32 i;
+                   if (mg->mg_obj)             /* @+ */
+                       i = t;
+                   else                        /* @- */
+                       i = s;
+
+                   if (i > 0 && RX_MATCH_UTF8(rx)) {
+                       const char * const b = rx->subbeg;
+                       if (b)
+                           i = Perl_utf8_length(aTHX_ (U8*)b, (U8*)(b+i));
+                   }
 
-               if (i > 0 && RX_MATCH_UTF8(rx)) {
-                   const char * const b = rx->subbeg;
-                   if (b)
-                       i = Perl_utf8_length(aTHX_ (U8*)b, (U8*)(b+i));
+                   sv_setiv(sv, i);
                }
-
-               sv_setiv(sv, i);
-           }
+       }
     }
     return 0;
 }
@@ -841,7 +843,10 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 
              getrx:
                if (i >= 0) {
+                   int oldtainted = PL_tainted;
+                   TAINT_NOT;
                    sv_setpvn(sv, s, i);
+                   PL_tainted = oldtainted;
                    if (RX_MATCH_UTF8(rx) && is_utf8_string((U8*)s, i))
                        SvUTF8_on(sv);
                    else
@@ -1118,12 +1123,13 @@ Perl_magic_clearenv(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_set_all_env(pTHX_ SV *sv, MAGIC *mg)
 {
-#if defined(VMS) || defined(EPOC)
+    PERL_UNUSED_ARG(mg);
+#if defined(VMS)
     Perl_die(aTHX_ "Can't make list assignment to %%ENV on this system");
 #else
     if (PL_localizing) {
        HE* entry;
-       magic_clear_all_env(sv,mg);
+       my_clearenv();
        hv_iterinit((HV*)sv);
        while ((entry = hv_iternext((HV*)sv))) {
            I32 keylen;
@@ -1139,39 +1145,13 @@ int
 Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg)
 {
     dVAR;
-#ifndef PERL_MICRO
-#if defined(VMS) || defined(EPOC)
-    Perl_die(aTHX_ "Can't make list assignment to %%ENV on this system");
-#else
-#  if defined(PERL_IMPLICIT_SYS) || defined(WIN32)
-    PerlEnv_clearenv();
-#  else
-#    ifdef USE_ENVIRON_ARRAY
-#      if defined(USE_ITHREADS)
-    /* only the parent thread can clobber the process environment */
-    if (PL_curinterp == aTHX)
-#      endif
-    {
-#      ifndef PERL_USE_SAFE_PUTENV
-    if (!PL_use_safe_putenv) {
-    I32 i;
-
-    if (environ == PL_origenviron)
-       environ = (char**)safesysmalloc(sizeof(char*));
-    else
-       for (i = 0; environ[i]; i++)
-           safesysfree(environ[i]);
-    }
-#      endif /* PERL_USE_SAFE_PUTENV */
-
-    environ[0] = Nullch;
-    }
-#    endif /* USE_ENVIRON_ARRAY */
-#   endif /* PERL_IMPLICIT_SYS || WIN32 */
-#endif /* VMS || EPOC */
-#endif /* !PERL_MICRO */
     PERL_UNUSED_ARG(sv);
     PERL_UNUSED_ARG(mg);
+#if defined(VMS)
+    Perl_die(aTHX_ "Can't make list assignment to %%ENV on this system");
+#else
+    my_clearenv();
+#endif
     return 0;
 }
 
@@ -1180,7 +1160,7 @@ Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg)
 static void
 restore_sigmask(pTHX_ SV *save_sv)
 {
-    const sigset_t *ossetp = (const sigset_t *) SvPV_nolen_const( save_sv );
+    const sigset_t * const ossetp = (const sigset_t *) SvPV_nolen_const( save_sv );
     (void)sigprocmask(SIG_SETMASK, ossetp, (sigset_t *)0);
 }
 #endif
@@ -1867,7 +1847,7 @@ Perl_magic_setglob(pTHX_ SV *sv, MAGIC *mg)
 
     if (!SvOK(sv))
        return 0;
-    gv = gv_fetchsv(sv,TRUE, SVt_PVGV);
+    gv =  gv_fetchsv(sv, GV_ADD, SVt_PVGV);
     if (sv == (SV*)gv)
        return 0;
     if (GvGP(sv))
@@ -2063,7 +2043,9 @@ Perl_magic_killbackrefs(pTHX_ SV *sv, MAGIC *mg)
     SV **svp = AvARRAY(av);
     PERL_UNUSED_ARG(sv);
 
-    if (svp) {
+    /* Not sure why the av can get freed ahead of its sv, but somehow it does
+       in ext/B/t/bytecode.t test 15 (involving print <DATA>)  */
+    if (svp && !SvIS_FREED(av)) {
        SV *const *const last = svp + AvFILLp(av);
 
        while (svp <= last) {
@@ -2325,12 +2307,12 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
     case '^':
        Safefree(IoTOP_NAME(GvIOp(PL_defoutgv)));
        s = IoTOP_NAME(GvIOp(PL_defoutgv)) = savesvpv(sv);
-       IoTOP_GV(GvIOp(PL_defoutgv)) = gv_fetchsv(sv,TRUE, SVt_PVIO);
+       IoTOP_GV(GvIOp(PL_defoutgv)) =  gv_fetchsv(sv, GV_ADD, SVt_PVIO);
        break;
     case '~':
        Safefree(IoFMT_NAME(GvIOp(PL_defoutgv)));
        s = IoFMT_NAME(GvIOp(PL_defoutgv)) = savesvpv(sv);
-       IoFMT_GV(GvIOp(PL_defoutgv)) = gv_fetchsv(sv,TRUE, SVt_PVIO);
+       IoFMT_GV(GvIOp(PL_defoutgv)) =  gv_fetchsv(sv, GV_ADD, SVt_PVIO);
        break;
     case '=':
        IoPAGE_LEN(GvIOp(PL_defoutgv)) = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
@@ -2682,7 +2664,7 @@ Perl_sighandler(int sig)
     if (!SvROK(PL_psig_ptr[sig]) || !(cv = (CV*)SvRV(PL_psig_ptr[sig]))
        || SvTYPE(cv) != SVt_PVCV) {
        HV *st;
-       cv = sv_2cv(PL_psig_ptr[sig],&st,&gv,TRUE);
+       cv = sv_2cv(PL_psig_ptr[sig], &st, &gv, GV_ADD);
     }
 
     if (!cv || !CvROOT(cv)) {
@@ -2738,6 +2720,8 @@ Perl_sighandler(int sig)
                   PUSHs((SV*)rv);
                   PUSHs(newSVpv((void*)sip, sizeof(*sip)));
              }
+
+              va_end(args);
         }
     }
 #endif