sv_setsv_cow: change prototype to allow this to fail

This will actually fail in some cases in the next commit.
tonycoz · Apr 4, 2024 · f71cf50 · f71cf50
1 parent bcd28b1
commit f71cf50
Show file tree

Hide file tree

Showing 4 changed files with 16 additions and 8 deletions.
diff --git a/embed.fnc b/embed.fnc
@@ -3979,7 +3979,7 @@ RTp	|MEM_SIZE|malloc_good_size					\
 #endif
 #if defined(PERL_ANY_COW)
 : Used in regexec.c
-EXpx	|SV *	|sv_setsv_cow	|NULLOK SV *dsv 			\
+EXpx	|bool	|sv_setsv_cow	|NN SV **pdsv				\
 				|NN SV *ssv
 #endif
 #if defined(PERL_CORE)

diff --git a/proto.h b/proto.h
diff --git a/regexec.c b/regexec.c
@@ -3534,7 +3534,9 @@ S_reg_set_capture_string(pTHX_ REGEXP * const rx,
             else {
                 /* create new COW SV to share string */
                 RXp_MATCH_COPY_FREE(prog);
-                RXp_SAVED_COPY(prog) = sv_setsv_cow(RXp_SAVED_COPY(prog), sv);
+                /* sv_setsv_cow() might not COW for some reason */
+                if (!sv_setsv_cow(&RXp_SAVED_COPY(prog), sv))
+                    goto didnt_cow;
             }
             RXp_SUBBEG(prog) = (char *)SvPVX_const(RXp_SAVED_COPY(prog));
             assert (SvPOKp(RXp_SAVED_COPY(prog)));
@@ -3544,6 +3546,9 @@ S_reg_set_capture_string(pTHX_ REGEXP * const rx,
         } else
 #endif
         {
+#ifdef PERL_ANY_COW
+        didnt_cow:
+#endif
             SSize_t min = 0;
             SSize_t max = strend - strbeg;
             SSize_t sublen;

diff --git a/sv.c b/sv.c
@@ -4889,8 +4889,8 @@ Perl_sv_setsv_mg(pTHX_ SV *const dsv, SV *const ssv)
 
 #ifdef PERL_ANY_COW
 #  define SVt_COW SVt_PV
-SV *
-Perl_sv_setsv_cow(pTHX_ SV *dsv, SV *ssv)
+bool
+Perl_sv_setsv_cow(pTHX_ SV **pdsv, SV *ssv)
 {
     STRLEN cur = SvCUR(ssv);
     STRLEN len = SvLEN(ssv);
@@ -4901,6 +4901,8 @@ Perl_sv_setsv_cow(pTHX_ SV *dsv, SV *ssv)
 #endif
 
     PERL_ARGS_ASSERT_SV_SETSV_COW;
+
+    SV *dsv = *pdsv;
 #ifdef DEBUGGING
     if (DEBUG_C_TEST) {
         PerlIO_printf(Perl_debug_log, "Fast copy on write: %p -> %p\n",
@@ -4955,6 +4957,7 @@ Perl_sv_setsv_cow(pTHX_ SV *dsv, SV *ssv)
     sv_buf_to_ro(ssv);
 
   common_exit:
+    *pdsv = dsv;
     SvPV_set(dsv, new_pv);
     SvFLAGS(dsv) = new_flags;
     if (SvUTF8(ssv))
@@ -4965,7 +4968,7 @@ Perl_sv_setsv_cow(pTHX_ SV *dsv, SV *ssv)
     if (DEBUG_C_TEST)
                 sv_dump(dsv);
 #endif
-    return dsv;
+    return TRUE;
 }
 #endif