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

[perl5.git] / mg.c

diff --git a/mg.c b/mg.c
index 1f6d062..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)));