Double magic with substr

Message-ID: <47F119E8.5010106@profvince.com>

p4raw-id: //depot/perl@33618

7 files changed, 39 insertions, 4 deletions

diff --git a/embed.fnc b/embed.fnc
index 94c57a3198..a8889c4778 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -884,6 +884,8 @@ Apd	|char*	|sv_grow	|NN SV *const sv|STRLEN newlen
 Apd	|void	|sv_inc		|NULLOK SV *const sv
 Apd	|void	|sv_insert	|NN SV *const bigstr|const STRLEN offset|const STRLEN len \
 				|NN const char *const little|const STRLEN littlelen
+Apd	|void	|sv_insert_flags|NN SV *const bigstr|const STRLEN offset|const STRLEN len \
+				|NN const char *const little|const STRLEN littlelen|const U32 flags
 Apd	|int	|sv_isa		|NULLOK SV* sv|NN const char *const name
 Apd	|int	|sv_isobject	|NULLOK SV* sv
 Apd	|STRLEN	|sv_len		|NULLOK SV *const sv
diff --git a/embed.h b/embed.h
index f8fce70315..57526c1f7c 100644
--- a/embed.h
+++ b/embed.h
@@ -886,6 +886,7 @@
 #define sv_grow			Perl_sv_grow
 #define sv_inc			Perl_sv_inc
 #define sv_insert		Perl_sv_insert
+#define sv_insert_flags		Perl_sv_insert_flags
 #define sv_isa			Perl_sv_isa
 #define sv_isobject		Perl_sv_isobject
 #define sv_len			Perl_sv_len
@@ -3188,6 +3189,7 @@
 #define sv_grow(a,b)		Perl_sv_grow(aTHX_ a,b)
 #define sv_inc(a)		Perl_sv_inc(aTHX_ a)
 #define sv_insert(a,b,c,d,e)	Perl_sv_insert(aTHX_ a,b,c,d,e)
+#define sv_insert_flags(a,b,c,d,e,f)	Perl_sv_insert_flags(aTHX_ a,b,c,d,e,f)
 #define sv_isa(a,b)		Perl_sv_isa(aTHX_ a,b)
 #define sv_isobject(a)		Perl_sv_isobject(aTHX_ a)
 #define sv_len(a)		Perl_sv_len(aTHX_ a)
diff --git a/global.sym b/global.sym
index 5423985109..870b77b212 100644
--- a/global.sym
+++ b/global.sym
@@ -523,6 +523,7 @@ Perl_sv_gets
 Perl_sv_grow
 Perl_sv_inc
 Perl_sv_insert
+Perl_sv_insert_flags
 Perl_sv_isa
 Perl_sv_isobject
 Perl_sv_len
diff --git a/pod/perlapi.pod b/pod/perlapi.pod
index b3a23bc54b..2644e88a8a 100644
--- a/pod/perlapi.pod
+++ b/pod/perlapi.pod
@@ -5755,13 +5755,23 @@ Found in file sv.c
 X<sv_insert>
 
 Inserts a string at the specified offset/length within the SV. Similar to
-the Perl substr() function.
+the Perl substr() function. Handles get magic.
 
 	void	sv_insert(SV *const bigstr, const STRLEN offset, const STRLEN len, const char *const little, const STRLEN littlelen)
 
 =for hackers
 Found in file sv.c
 
+=item sv_insert_flags
+X<sv_insert_flags>
+
+Same as C<sv_insert>, but the extra C<flags> are passed the C<SvPV_force_flags> that applies to C<bigstr>.
+
+	void	sv_insert_flags(SV *const bigstr, const STRLEN offset, const STRLEN len, const char *const little, const STRLEN littlelen, const U32 flags)
+
+=for hackers
+Found in file sv.c
+
 =item sv_isa
 X<sv_isa>
 
diff --git a/pp.c b/pp.c
index 8e2a395c42..d940d104c1 100644
--- a/pp.c
+++ b/pp.c
@@ -3180,7 +3180,7 @@ PP(pp_substr)
 	    }
 	    if (!SvOK(sv))
 		sv_setpvs(sv, "");
-	    sv_insert(sv, pos, rem, repl, repl_len);
+	    sv_insert_flags(sv, pos, rem, repl, repl_len, 0);
 	    if (repl_is_utf8)
 		SvUTF8_on(sv);
 	    if (repl_sv_copy)
diff --git a/proto.h b/proto.h
index 9e597d0c70..67e4913c0a 100644
--- a/proto.h
+++ b/proto.h
@@ -3185,6 +3185,12 @@ PERL_CALLCONV void	Perl_sv_insert(pTHX_ SV *const bigstr, const STRLEN offset, c
 #define PERL_ARGS_ASSERT_SV_INSERT	\
 	assert(bigstr); assert(little)
 
+PERL_CALLCONV void	Perl_sv_insert_flags(pTHX_ SV *const bigstr, const STRLEN offset, const STRLEN len, const char *const little, const STRLEN littlelen, const U32 flags)
+			__attribute__nonnull__(pTHX_1)
+			__attribute__nonnull__(pTHX_4);
+#define PERL_ARGS_ASSERT_SV_INSERT_FLAGS	\
+	assert(bigstr); assert(little)
+
 PERL_CALLCONV int	Perl_sv_isa(pTHX_ SV* sv, const char *const name)
 			__attribute__nonnull__(pTHX_2);
 #define PERL_ARGS_ASSERT_SV_ISA	\
diff --git a/sv.c b/sv.c
index f2b24a6787..deefc33257 100644
--- a/sv.c
+++ b/sv.c
@@ -5140,7 +5140,7 @@ Perl_sv_kill_backrefs(pTHX_ SV *const sv, AV *const av)
 =for apidoc sv_insert
 
 Inserts a string at the specified offset/length within the SV. Similar to
-the Perl substr() function.
+the Perl substr() function. Handles get magic.
 
 =cut
 */
@@ -5149,6 +5149,20 @@ void
 Perl_sv_insert(pTHX_ SV *const bigstr, const STRLEN offset, const STRLEN len, 
               const char *const little, const STRLEN littlelen)
 {
+    sv_insert_flags(bigstr, offset, len, little, littlelen, SV_GMAGIC);
+}
+
+/*
+=for apidoc sv_insert_flags
+
+Same as C<sv_insert>, but the extra C<flags> are passed the C<SvPV_force_flags> that applies to C<bigstr>.
+
+=cut
+*/
+
+void
+Perl_sv_insert_flags(pTHX_ SV *const bigstr, const STRLEN offset, const STRLEN len, const char *const little, const STRLEN littlelen, const U32 flags)
+{
     dVAR;
     register char *big;
     register char *mid;
@@ -5161,7 +5175,7 @@ Perl_sv_insert(pTHX_ SV *const bigstr, const STRLEN offset, const STRLEN len,
 
     if (!bigstr)
 	Perl_croak(aTHX_ "Can't modify non-existent substring");
-    SvPV_force(bigstr, curlen);
+    SvPV_force_flags(bigstr, curlen, flags);
     (void)SvPOK_only_UTF8(bigstr);
     if (offset + len > curlen) {
 	SvGROW(bigstr, offset+len+1);