Assert that we don't access strings saved for $1 etc. out of bounds

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

diff --git a/mg.c b/mg.c
index 8e00fb2..f82aa0d 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -730,7 +730,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
             {
                 const int saveerrno = errno;
                 sv_setnv(sv, (NV)errno);
-                sv_setpv(sv, (const char *)(errno ? Strerror(errno) : ""));
+                sv_setpv(sv, errno ? Strerror(errno) : "");
                 errno = saveerrno;
             }
 #endif
@@ -810,11 +810,11 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
                sv_setpvn(sv, WARN_NONEstring, WARNsize) ;
            }
            else if (PL_compiling.cop_warnings == pWARN_STD) {
-               sv_setpvn(sv,
-                         (const char *)
-                         ((PL_dowarn & G_WARN_ON) ?
-                          WARN_ALLstring : WARN_NONEstring),
-                         WARNsize);
+               sv_setpvn(
+                   sv, 
+                   (PL_dowarn & G_WARN_ON) ? WARN_ALLstring : WARN_NONEstring,
+                   WARNsize
+               );
            }
             else if (PL_compiling.cop_warnings == pWARN_ALL) {
                /* Get the bit mask for $warnings::Bits{all}, because
@@ -854,6 +854,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
                i = t1 - s1;
                s = rx->subbeg + s1;
                assert(rx->subbeg);
+               assert(rx->sublen >= s1);
 
              getrx:
                if (i >= 0) {
@@ -861,8 +862,13 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
                    TAINT_NOT;
                    sv_setpvn(sv, s, i);
                    PL_tainted = oldtainted;
-                   if (RX_MATCH_UTF8(rx) && is_utf8_string((U8*)s, i))
+                   if ( (rx->reganch & ROPT_CANY_SEEN)
+                       ? (RX_MATCH_UTF8(rx)
+                                   && (!i || is_utf8_string((U8*)s, i)))
+                       : (RX_MATCH_UTF8(rx)) )
+                   {
                        SvUTF8_on(sv);
+                   }
                    else
                        SvUTF8_off(sv);
                    if (PL_tainting) {
@@ -993,7 +999,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
            sv_setpv(sv, os2error(Perl_rc));
        else
 #endif
-       sv_setpv(sv, (const char *)(errno ? Strerror(errno) : ""));
+       sv_setpv(sv, errno ? Strerror(errno) : "");
        errno = saveerrno;
        }
 #endif
@@ -1048,7 +1054,7 @@ Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg)
 {
     dVAR;
     STRLEN len = 0, klen;
-    const char *s = SvOK(sv) ? SvPV_const(sv,len) : (const char *)"";
+    const char *s = SvOK(sv) ? SvPV_const(sv,len) : "";
     const char * const ptr = MgPV_const(mg,klen);
     my_setenv(ptr, s);
 
@@ -1224,14 +1230,12 @@ Perl_magic_clearsig(pTHX_ SV *sv, MAGIC *mg)
        SV** svp = NULL;
        if (strEQ(s,"__DIE__"))
            svp = &PL_diehook;
-       else if (strEQ(s,"__WARN__"))
+       else if (strEQ(s,"__WARN__") && PL_warnhook != PERL_WARNHOOK_FATAL)
            svp = &PL_warnhook;
-       else
-           Perl_croak(aTHX_ "No such hook: %s", s);
        if (svp && *svp) {
-            SV * const to_dec = *svp;
+           SV *const to_dec = *svp;
            *svp = NULL;
-           SvREFCNT_dec(to_dec);
+           SvREFCNT_dec(to_dec);
        }
     }
     else {
@@ -1311,7 +1315,17 @@ Perl_csighandler(int sig)
             exit(1);
 #endif
 #endif
-   if (PL_signals & PERL_SIGNALS_UNSAFE_FLAG)
+   if (
+#ifdef SIGILL
+          sig == SIGILL ||
+#endif
+#ifdef SIGBUS
+          sig == SIGBUS ||
+#endif
+#ifdef SIGSEGV
+          sig == SIGSEGV ||
+#endif
+          (PL_signals & PERL_SIGNALS_UNSAFE_FLAG))
        /* Call the perl level handler now--
         * with risk we may be in malloc() etc. */
        (*PL_sighandlerp)(sig);
@@ -1384,7 +1398,8 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
            Perl_croak(aTHX_ "No such hook: %s", s);
        i = 0;
        if (*svp) {
-           to_dec = *svp;
+           if (*svp != PERL_WARNHOOK_FATAL)
+               to_dec = *svp;
            *svp = NULL;
        }
     }
@@ -1649,7 +1664,7 @@ int
 Perl_magic_nextpack(pTHX_ SV *sv, MAGIC *mg, SV *key)
 {
     dVAR; dSP;
-    const char * const meth = (const char *)(SvOK(key) ? "NEXTKEY" : "FIRSTKEY");
+    const char * const meth = SvOK(key) ? "NEXTKEY" : "FIRSTKEY";
 
     ENTER;
     SAVETMPS;
@@ -2290,11 +2305,16 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
                        accumulate |= ptr[i] ;
                        any_fatals |= (ptr[i] & 0xAA) ;
                    }
-                   if (!accumulate)
-                       PL_compiling.cop_warnings = pWARN_NONE;
+                   if (!accumulate) {
+                       if (!specialWARN(PL_compiling.cop_warnings))
+                           PerlMemShared_free(PL_compiling.cop_warnings);
+                       PL_compiling.cop_warnings = pWARN_NONE;
+                   }
                    /* Yuck. I can't see how to abstract this:  */
                    else if (isWARN_on(((STRLEN *)SvPV_nolen_const(sv)) - 1,
                                       WARN_ALL) && !any_fatals) {
+                       if (!specialWARN(PL_compiling.cop_warnings))
+                           PerlMemShared_free(PL_compiling.cop_warnings);
                        PL_compiling.cop_warnings = pWARN_ALL;
                        PL_dowarn |= G_WARN_ONCE ;
                    }