In perl.git, the branch blead has been updated

<https://perl5.git.perl.org/perl.git/commitdiff/238f2c136aa0ab2a1070f175ec56ef61b91ff79d?hp=929e53be972b0c811eca54a3c7017db116f62e4a>

- Log -----------------------------------------------------------------
commit 238f2c136aa0ab2a1070f175ec56ef61b91ff79d
Author: Pali <[email protected]>
Date:   Thu Feb 7 14:10:35 2019 +0100

    Add newSVsv_nomg() macro which is like newSVsv() but does not process get 
magic
    
    Both newSVsv() and newSVsv_nomg() are now implemented via new 
Perl_newSVsv_flags() function.

-----------------------------------------------------------------------

Summary of changes:
 embed.fnc |  4 +++-
 embed.h   |  2 +-
 mathoms.c |  6 ++++++
 proto.h   |  8 ++++++++
 sv.c      | 13 ++++++++-----
 sv.h      |  5 +++++
 6 files changed, 31 insertions(+), 7 deletions(-)

diff --git a/embed.fnc b/embed.fnc
index 808ef83958..17011f2013 100644
--- 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
-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 \
diff --git a/embed.h b/embed.h
index fa1a3766eb..9439f4083b 100644
--- a/embed.h
+++ b/embed.h
@@ -546,7 +546,7 @@
 #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)
diff --git a/mathoms.c b/mathoms.c
index 8b003d3538..b8dcb8913d 100644
--- a/mathoms.c
+++ b/mathoms.c
@@ -1755,6 +1755,12 @@ Perl_instr(const char *big, const char *little)
     return instr((char *) big, (char *) little);
 }
 
+SV *
+Perl_newSVsv(pTHX_ SV *const old)
+{
+    return newSVsv(old);
+}
+
 #endif /* NO_MATHOMS */
 
 /*
diff --git a/proto.h b/proto.h
index 5e7b23f419..b7a3eb3fd9 100644
--- 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)
+#ifndef NO_MATHOMS
 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__;
diff --git a/sv.c b/sv.c
index 0bb96391e0..2123cf497b 100644
--- 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>.)
 
+=for apidoc newSVsv_nomg
+
+Like C<newSVsv> but does not process get magic.
+
 =cut
 */
 
 SV *
-Perl_newSVsv(pTHX_ SV *const old)
+Perl_newSVsv_flags(pTHX_ SV *const old, I32 flags)
 {
     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. */
-    SvGETMAGIC(old);
+    if (flags & SV_GMAGIC)
+        SvGETMAGIC(old);
     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;
 }
 
diff --git a/sv.h b/sv.h
index f3392b08ec..3a648e4971 100644
--- a/sv.h
+++ b/sv.h
@@ -2175,6 +2175,11 @@ struct clone_params {
   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
 

-- 
Perl5 Master Repository

Reply via email to