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 d4412f8..f82aa0d 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -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) {
@@ -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);
@@ -2291,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 ;
                    }