This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add newSVsv_nomg() macro which is like newSVsv() but does not process get magic
authorPali <pali@cpan.org>
Thu, 7 Feb 2019 13:10:35 +0000 (14:10 +0100)
committerTony Cook <tony@develop-help.com>
Sun, 24 Feb 2019 23:17:20 +0000 (10:17 +1100)
Both newSVsv() and newSVsv_nomg() are now implemented via new Perl_newSVsv_flags() function.

embed.fnc
embed.h
mathoms.c
proto.h
sv.c
sv.h

index 808ef83..17011f2 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1209,7 +1209,9 @@ ApdR      |SV*    |newSVpv_share  |NULLOK const char* s|U32 hash
 AfpdR  |SV*    |newSVpvf       |NN const char *const pat|...
 ApR    |SV*    |vnewSVpvf      |NN const char *const pat|NULLOK va_list *const args
 Apd    |SV*    |newSVrv        |NN SV *const rv|NULLOK const char *const classname
 AfpdR  |SV*    |newSVpvf       |NN const char *const pat|...
 ApR    |SV*    |vnewSVpvf      |NN const char *const pat|NULLOK va_list *const args
 Apd    |SV*    |newSVrv        |NN SV *const rv|NULLOK const char *const classname
-ApdR   |SV*    |newSVsv        |NULLOK SV *const old
+ApmbdR |SV*    |newSVsv        |NULLOK SV *const old
+ApmdR  |SV*    |newSVsv_nomg   |NULLOK SV *const old
+ApR    |SV*    |newSVsv_flags  |NULLOK SV *const old|I32 flags
 ApdR   |SV*    |newSV_type     |const svtype type
 ApdR   |OP*    |newUNOP        |I32 type|I32 flags|NULLOK OP* first
 ApdR   |OP*    |newUNOP_AUX    |I32 type|I32 flags|NULLOK OP* first \
 ApdR   |SV*    |newSV_type     |const svtype type
 ApdR   |OP*    |newUNOP        |I32 type|I32 flags|NULLOK OP* first
 ApdR   |OP*    |newUNOP_AUX    |I32 type|I32 flags|NULLOK OP* first \
diff --git a/embed.h b/embed.h
index fa1a376..9439f40 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define newSVpvn_flags(a,b,c)  Perl_newSVpvn_flags(aTHX_ a,b,c)
 #define newSVpvn_share(a,b,c)  Perl_newSVpvn_share(aTHX_ a,b,c)
 #define newSVrv(a,b)           Perl_newSVrv(aTHX_ a,b)
 #define newSVpvn_flags(a,b,c)  Perl_newSVpvn_flags(aTHX_ a,b,c)
 #define newSVpvn_share(a,b,c)  Perl_newSVpvn_share(aTHX_ a,b,c)
 #define newSVrv(a,b)           Perl_newSVrv(aTHX_ a,b)
-#define newSVsv(a)             Perl_newSVsv(aTHX_ a)
+#define newSVsv_flags(a,b)     Perl_newSVsv_flags(aTHX_ a,b)
 #define newSVuv(a)             Perl_newSVuv(aTHX_ a)
 #define newUNOP(a,b,c)         Perl_newUNOP(aTHX_ a,b,c)
 #define newUNOP_AUX(a,b,c,d)   Perl_newUNOP_AUX(aTHX_ a,b,c,d)
 #define newSVuv(a)             Perl_newSVuv(aTHX_ a)
 #define newUNOP(a,b,c)         Perl_newUNOP(aTHX_ a,b,c)
 #define newUNOP_AUX(a,b,c,d)   Perl_newUNOP_AUX(aTHX_ a,b,c,d)
index 8b003d3..b8dcb89 100644 (file)
--- a/mathoms.c
+++ b/mathoms.c
@@ -1755,6 +1755,12 @@ Perl_instr(const char *big, const char *little)
     return instr((char *) big, (char *) little);
 }
 
     return instr((char *) big, (char *) little);
 }
 
+SV *
+Perl_newSVsv(pTHX_ SV *const old)
+{
+    return newSVsv(old);
+}
+
 #endif /* NO_MATHOMS */
 
 /*
 #endif /* NO_MATHOMS */
 
 /*
diff --git a/proto.h b/proto.h
index 5e7b23f..b7a3eb3 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -2516,8 +2516,16 @@ PERL_CALLCONV SV*        Perl_newSVpvn_share(pTHX_ const char* s, I32 len, U32 hash)
 PERL_CALLCONV SV*      Perl_newSVrv(pTHX_ SV *const rv, const char *const classname);
 #define PERL_ARGS_ASSERT_NEWSVRV       \
        assert(rv)
 PERL_CALLCONV SV*      Perl_newSVrv(pTHX_ SV *const rv, const char *const classname);
 #define PERL_ARGS_ASSERT_NEWSVRV       \
        assert(rv)
+#ifndef NO_MATHOMS
 PERL_CALLCONV SV*      Perl_newSVsv(pTHX_ SV *const old)
                        __attribute__warn_unused_result__;
 PERL_CALLCONV SV*      Perl_newSVsv(pTHX_ SV *const old)
                        __attribute__warn_unused_result__;
+#endif
+
+PERL_CALLCONV SV*      Perl_newSVsv_flags(pTHX_ SV *const old, I32 flags)
+                       __attribute__warn_unused_result__;
+
+/* PERL_CALLCONV SV*   Perl_newSVsv_nomg(pTHX_ SV *const old)
+                       __attribute__warn_unused_result__; */
 
 PERL_CALLCONV SV*      Perl_newSVuv(pTHX_ const UV u)
                        __attribute__warn_unused_result__;
 
 PERL_CALLCONV SV*      Perl_newSVuv(pTHX_ const UV u)
                        __attribute__warn_unused_result__;
diff --git a/sv.c b/sv.c
index 0bb9639..2123cf4 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -9750,11 +9750,15 @@ Perl_newRV(pTHX_ SV *const sv)
 Creates a new SV which is an exact duplicate of the original SV.
 (Uses C<sv_setsv>.)
 
 Creates a new SV which is an exact duplicate of the original SV.
 (Uses C<sv_setsv>.)
 
+=for apidoc newSVsv_nomg
+
+Like C<newSVsv> but does not process get magic.
+
 =cut
 */
 
 SV *
 =cut
 */
 
 SV *
-Perl_newSVsv(pTHX_ SV *const old)
+Perl_newSVsv_flags(pTHX_ SV *const old, I32 flags)
 {
     SV *sv;
 
 {
     SV *sv;
 
@@ -9765,11 +9769,10 @@ Perl_newSVsv(pTHX_ SV *const old)
        return NULL;
     }
     /* Do this here, otherwise we leak the new SV if this croaks. */
        return NULL;
     }
     /* Do this here, otherwise we leak the new SV if this croaks. */
-    SvGETMAGIC(old);
+    if (flags & SV_GMAGIC)
+        SvGETMAGIC(old);
     new_SV(sv);
     new_SV(sv);
-    /* SV_NOSTEAL prevents TEMP buffers being, well, stolen, and saves games
-       with SvTEMP_off and SvTEMP_on round a call to sv_setsv.  */
-    sv_setsv_flags(sv, old, SV_NOSTEAL);
+    sv_setsv_flags(sv, old, flags & ~SV_GMAGIC);
     return sv;
 }
 
     return sv;
 }
 
diff --git a/sv.h b/sv.h
index f3392b0..3a648e4 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -2175,6 +2175,11 @@ struct clone_params {
   AV *unreferenced;
 };
 
   AV *unreferenced;
 };
 
+/* SV_NOSTEAL prevents TEMP buffers being, well, stolen, and saves games
+   with SvTEMP_off and SvTEMP_on round a call to sv_setsv.  */
+#define newSVsv(sv) newSVsv_flags((sv), SV_GMAGIC|SV_NOSTEAL)
+#define newSVsv_nomg(sv) newSVsv_flags((sv), SV_NOSTEAL)
+
 /*
 =for apidoc Am|SV*|newSVpvn_utf8|const char* s|STRLEN len|U32 utf8
 
 /*
 =for apidoc Am|SV*|newSVpvn_utf8|const char* s|STRLEN len|U32 utf8