Double magic with substr

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

p4raw-id: //depot/perl@33618

diff --git a/embed.fnc b/embed.fnc
index 94c57a3..a8889c4 100644 (file)
--- 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 f8fce70..57526c1 100644 (file)
--- 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 5423985..870b77b 100644 (file)
--- 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 b3a23bc..2644e88 100644 (file)
--- 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 8e2a395..d940d10 100644 (file)
--- 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 9e597d0..67e4913 100644 (file)
--- 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 f2b24a6..deefc33 100644 (file)
--- 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);