[perl #107000] Don’t leak if hh copying dies

[perl5.git] / mg.c

diff --git a/mg.c b/mg.c
index 09f9b60..cbae421 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -637,6 +637,8 @@ Perl_magic_regdata_cnt(pTHX_ SV *sv, MAGIC *mg)
     return (U32)-1;
 }
 
+/* @-, @+ */
+
 int
 Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg)
 {
@@ -665,7 +667,9 @@ Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg)
                    if (i > 0 && RX_MATCH_UTF8(rx)) {
                        const char * const b = RX_SUBBEG(rx);
                        if (b)
-                           i = utf8_length((U8*)b, (U8*)(b+i));
+                           i = RX_SUBCOFFSET(rx) +
+                                    utf8_length((U8*)b,
+                                        (U8*)(b-RX_SUBOFFSET(rx)+i));
                    }
 
                    sv_setiv(sv, i);
@@ -675,6 +679,8 @@ Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg)
     return 0;
 }
 
+/* @-, @+ */
+
 int
 Perl_magic_regdatum_set(pTHX_ SV *sv, MAGIC *mg)
 {
@@ -900,6 +906,20 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
     case '\011':               /* ^I */ /* NOT \t in EBCDIC */
        sv_setpv(sv, PL_inplace); /* Will undefine sv if PL_inplace is NULL */
        break;
+    case '\014':               /* ^LAST_FH */
+       if (strEQ(remaining, "AST_FH")) {
+           if (PL_last_in_gv) {
+               assert(isGV_with_GP(PL_last_in_gv));
+               SV_CHECK_THINKFIRST_COW_DROP(sv);
+               prepare_SV_for_RV(sv);
+               SvOK_off(sv);
+               SvRV_set(sv, SvREFCNT_inc_simple_NN(PL_last_in_gv));
+               SvROK_on(sv);
+               sv_rvweaken(sv);
+           }
+           else sv_setsv_nomg(sv, NULL);
+       }
+       break;
     case '\017':               /* ^O & ^OPEN */
        if (nextchar == '\0') {
            sv_setpv(sv, PL_osname);
@@ -913,9 +933,12 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
        if (nextchar == '\0') {       /* ^P */
            sv_setiv(sv, (IV)PL_perldb);
        } else if (strEQ(remaining, "REMATCH")) { /* $^PREMATCH */
-           goto do_prematch_fetch;
+
+            paren = RX_BUFF_IDX_CARET_PREMATCH;
+           goto do_numbuf_fetch;
        } else if (strEQ(remaining, "OSTMATCH")) { /* $^POSTMATCH */
-           goto do_postmatch_fetch;
+            paren = RX_BUFF_IDX_CARET_POSTMATCH;
+           goto do_numbuf_fetch;
        }
        break;
     case '\023':               /* ^S */
@@ -978,55 +1001,46 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
        break;
     case '\015': /* $^MATCH */
        if (strEQ(remaining, "ATCH")) {
+            paren = RX_BUFF_IDX_CARET_FULLMATCH;
+           goto do_numbuf_fetch;
+        }
+
     case '1': case '2': case '3': case '4':
     case '5': case '6': case '7': case '8': case '9': case '&':
-           if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
-               /*
-                * Pre-threads, this was paren = atoi(GvENAME((const GV *)mg->mg_obj));
-                * XXX Does the new way break anything?
-                */
-               paren = atoi(mg->mg_ptr); /* $& is in [0] */
-               CALLREG_NUMBUF_FETCH(rx,paren,sv);
-               break;
-           }
-           sv_setsv(sv,&PL_sv_undef);
-       }
+        /*
+         * Pre-threads, this was paren = atoi(GvENAME((const GV *)mg->mg_obj));
+         * XXX Does the new way break anything?
+         */
+        paren = atoi(mg->mg_ptr); /* $& is in [0] */
+      do_numbuf_fetch:
+        if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
+            CALLREG_NUMBUF_FETCH(rx,paren,sv);
+            break;
+        }
+        sv_setsv(sv,&PL_sv_undef);
        break;
     case '+':
        if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
-           if (RX_LASTPAREN(rx)) {
-               CALLREG_NUMBUF_FETCH(rx,RX_LASTPAREN(rx),sv);
-               break;
-           }
+           paren = RX_LASTPAREN(rx);
+           if (paren)
+                goto do_numbuf_fetch;
        }
        sv_setsv(sv,&PL_sv_undef);
        break;
     case '\016':               /* ^N */
        if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
-           if (RX_LASTCLOSEPAREN(rx)) {
-               CALLREG_NUMBUF_FETCH(rx,RX_LASTCLOSEPAREN(rx),sv);
-               break;
-           }
-
+           paren = RX_LASTCLOSEPAREN(rx);
+           if (paren)
+                goto do_numbuf_fetch;
        }
        sv_setsv(sv,&PL_sv_undef);
        break;
     case '`':
-      do_prematch_fetch:
-       if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
-           CALLREG_NUMBUF_FETCH(rx,-2,sv);
-           break;
-       }
-       sv_setsv(sv,&PL_sv_undef);
-       break;
+        paren = RX_BUFF_IDX_PREMATCH;
+        goto do_numbuf_fetch;
     case '\'':
-      do_postmatch_fetch:
-       if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
-           CALLREG_NUMBUF_FETCH(rx,-1,sv);
-           break;
-       }
-       sv_setsv(sv,&PL_sv_undef);
-       break;
+        paren = RX_BUFF_IDX_POSTMATCH;
+        goto do_numbuf_fetch;
     case '.':
        if (GvIO(PL_last_in_gv)) {
            sv_setiv(sv, (IV)IoLINES(GvIOp(PL_last_in_gv)));
@@ -2020,11 +2034,17 @@ Perl_magic_setdbline(pTHX_ SV *sv, MAGIC *mg)
     if (svp && SvIOKp(*svp)) {
        OP * const o = INT2PTR(OP*,SvIVX(*svp));
        if (o) {
+#ifdef PERL_DEBUG_READONLY_OPS
+           Slab_to_rw(OpSLAB(o));
+#endif
            /* set or clear breakpoint in the relevant control op */
            if (i)
                o->op_flags |= OPf_SPECIAL;
            else
                o->op_flags &= ~OPf_SPECIAL;
+#ifdef PERL_DEBUG_READONLY_OPS
+           Slab_to_ro(OpSLAB(o));
+#endif
        }
     }
     return 0;
@@ -2204,7 +2224,7 @@ Perl_magic_getsubstr(pTHX_ SV *sv, MAGIC *mg)
     PERL_UNUSED_ARG(mg);
 
     if (!translate_substr_offsets(
-           SvUTF8(lsv) ? sv_len_utf8(lsv) : len,
+           SvUTF8(lsv) ? sv_len_utf8_nomg(lsv) : len,
            negoff ? -(IV)offs : (IV)offs, !negoff,
            negrem ? -(IV)rem  : (IV)rem,  !negrem, &offs, &rem
     )) {
@@ -2241,7 +2261,7 @@ Perl_magic_setsubstr(pTHX_ SV *sv, MAGIC *mg)
        Perl_ck_warner(aTHX_ packWARN(WARN_SUBSTR),
                            "Attempt to use reference as lvalue in substr"
        );
-    if (SvUTF8(lsv)) lsv_len = sv_len_utf8(lsv);
+    if (SvUTF8(lsv)) lsv_len = sv_len_utf8_nomg(lsv);
     else (void)SvPV_nomg(lsv,lsv_len);
     if (!translate_substr_offsets(
            lsv_len,