Merge sv_usepvn and sv_usepvn_mg into sv_usepvn_flags. "Promote" the

other two to mathoms.c

p4raw-id: //depot/perl@27840

diff --git a/embed.fnc b/embed.fnc
index 1d8e5f1..08bc2e4 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -849,7 +849,9 @@ Apdmb       |void   |sv_unref       |NN SV* sv
 Apd    |void   |sv_unref_flags |NN SV* sv|U32 flags
 Apd    |void   |sv_untaint     |NN SV* sv
 Apd    |void   |sv_upgrade     |NN SV* sv|U32 mt
-Apd    |void   |sv_usepvn      |NN SV* sv|NULLOK char* ptr|STRLEN len
+Apdmb  |void   |sv_usepvn      |NN SV* sv|NULLOK char* ptr|STRLEN len
+Apd    |void   |sv_usepvn_flags|NN SV* sv|NULLOK char* ptr|STRLEN len\
+                               |U32 flags
 Apd    |void   |sv_vcatpvfn    |NN SV* sv|NN const char* pat|STRLEN patlen \
                                |NULLOK va_list* args|NULLOK SV** svargs|I32 svmax \
                                |NULLOK bool *maybe_tainted
@@ -961,7 +963,7 @@ Apd |void   |sv_setnv_mg    |NN SV *sv|NV num
 Apd    |void   |sv_setpv_mg    |NN SV *sv|NULLOK const char *ptr
 Apd    |void   |sv_setpvn_mg   |NN SV *sv|NN const char *ptr|STRLEN len
 Apd    |void   |sv_setsv_mg    |NN SV *dstr|NULLOK SV *sstr
-Apd    |void   |sv_usepvn_mg   |NN SV *sv|NULLOK char *ptr|STRLEN len
+Apdbm  |void   |sv_usepvn_mg   |NN SV *sv|NULLOK char *ptr|STRLEN len
 ApR    |MGVTBL*|get_vtbl       |int vtbl_id
 Ap     |char*  |pv_display     |NN SV *dsv|NN const char *pv|STRLEN cur|STRLEN len \
                                |STRLEN pvlim

diff --git a/embed.h b/embed.h
index c83467f..2afc074 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -881,7 +881,7 @@
 #define sv_unref_flags         Perl_sv_unref_flags
 #define sv_untaint             Perl_sv_untaint
 #define sv_upgrade             Perl_sv_upgrade
-#define sv_usepvn              Perl_sv_usepvn
+#define sv_usepvn_flags                Perl_sv_usepvn_flags
 #define sv_vcatpvfn            Perl_sv_vcatpvfn
 #define sv_vsetpvfn            Perl_sv_vsetpvfn
 #define str_to_version         Perl_str_to_version
@@ -989,7 +989,6 @@
 #define sv_setpv_mg            Perl_sv_setpv_mg
 #define sv_setpvn_mg           Perl_sv_setpvn_mg
 #define sv_setsv_mg            Perl_sv_setsv_mg
-#define sv_usepvn_mg           Perl_sv_usepvn_mg
 #define get_vtbl               Perl_get_vtbl
 #define pv_display             Perl_pv_display
 #define dump_indent            Perl_dump_indent
@@ -3040,7 +3039,7 @@
 #define sv_unref_flags(a,b)    Perl_sv_unref_flags(aTHX_ a,b)
 #define sv_untaint(a)          Perl_sv_untaint(aTHX_ a)
 #define sv_upgrade(a,b)                Perl_sv_upgrade(aTHX_ a,b)
-#define sv_usepvn(a,b,c)       Perl_sv_usepvn(aTHX_ a,b,c)
+#define sv_usepvn_flags(a,b,c,d)       Perl_sv_usepvn_flags(aTHX_ a,b,c,d)
 #define sv_vcatpvfn(a,b,c,d,e,f,g)     Perl_sv_vcatpvfn(aTHX_ a,b,c,d,e,f,g)
 #define sv_vsetpvfn(a,b,c,d,e,f,g)     Perl_sv_vsetpvfn(aTHX_ a,b,c,d,e,f,g)
 #define str_to_version(a)      Perl_str_to_version(aTHX_ a)
@@ -3144,7 +3143,6 @@
 #define sv_setpv_mg(a,b)       Perl_sv_setpv_mg(aTHX_ a,b)
 #define sv_setpvn_mg(a,b,c)    Perl_sv_setpvn_mg(aTHX_ a,b,c)
 #define sv_setsv_mg(a,b)       Perl_sv_setsv_mg(aTHX_ a,b)
-#define sv_usepvn_mg(a,b,c)    Perl_sv_usepvn_mg(aTHX_ a,b,c)
 #define get_vtbl(a)            Perl_get_vtbl(aTHX_ a)
 #define pv_display(a,b,c,d,e)  Perl_pv_display(aTHX_ a,b,c,d,e)
 #define dump_vindent(a,b,c,d)  Perl_dump_vindent(aTHX_ a,b,c,d)

diff --git a/global.sym b/global.sym
index e0595f2..61f8b46 100644 (file)
--- a/global.sym
+++ b/global.sym
@@ -529,6 +529,7 @@ Perl_sv_unref_flags
 Perl_sv_untaint
 Perl_sv_upgrade
 Perl_sv_usepvn
+Perl_sv_usepvn_flags
 Perl_sv_vcatpvfn
 Perl_sv_vsetpvfn
 Perl_str_to_version

diff --git a/mathoms.c b/mathoms.c
index 3636a9b..967e035 100644 (file)
--- a/mathoms.c
+++ b/mathoms.c
@@ -1205,6 +1205,37 @@ Perl_save_destructor(pTHX_ DESTRUCTORFUNC_NOCONTEXT_t f, void* p)
     SSPUSHINT(SAVEt_DESTRUCTOR);
 }
 
+
+/*
+=for apidoc sv_usepvn_mg
+
+Like C<sv_usepvn>, but also handles 'set' magic.
+
+=cut
+*/
+
+void
+Perl_sv_usepvn_mg(pTHX_ SV *sv, char *ptr, STRLEN len)
+{
+    sv_usepvn_flags(sv,ptr,len, SV_SMAGIC);
+}
+
+/*
+=for apidoc sv_usepvn
+
+Tells an SV to use C<ptr> to find its string value. Implemented by
+calling C<sv_usepvn_flags> with C<flags> of 0, hence does not handle 'set'
+magic. See C<sv_usepvn_flags>.
+
+=cut
+*/
+
+void
+Perl_sv_usepvn(pTHX_ SV *sv, char *ptr, STRLEN len)
+{
+    sv_usepvn_flags(sv,ptr,len, 0);
+}
+
 #endif /* NO_MATHOMS */
 
 /*

diff --git a/proto.h b/proto.h
index 261f6b2..1cd6131 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -2337,7 +2337,10 @@ PERL_CALLCONV void       Perl_sv_untaint(pTHX_ SV* sv)
 PERL_CALLCONV void     Perl_sv_upgrade(pTHX_ SV* sv, U32 mt)
                        __attribute__nonnull__(pTHX_1);
 
-PERL_CALLCONV void     Perl_sv_usepvn(pTHX_ SV* sv, char* ptr, STRLEN len)
+/* PERL_CALLCONV void  Perl_sv_usepvn(pTHX_ SV* sv, char* ptr, STRLEN len)
+                       __attribute__nonnull__(pTHX_1); */
+
+PERL_CALLCONV void     Perl_sv_usepvn_flags(pTHX_ SV* sv, char* ptr, STRLEN len, U32 flags)
                        __attribute__nonnull__(pTHX_1);
 
 PERL_CALLCONV void     Perl_sv_vcatpvfn(pTHX_ SV* sv, const char* pat, STRLEN patlen, va_list* args, SV** svargs, I32 svmax, bool *maybe_tainted)
@@ -2634,8 +2637,8 @@ PERL_CALLCONV void        Perl_sv_setpvn_mg(pTHX_ SV *sv, const char *ptr, STRLEN len)
 PERL_CALLCONV void     Perl_sv_setsv_mg(pTHX_ SV *dstr, SV *sstr)
                        __attribute__nonnull__(pTHX_1);
 
-PERL_CALLCONV void     Perl_sv_usepvn_mg(pTHX_ SV *sv, char *ptr, STRLEN len)
-                       __attribute__nonnull__(pTHX_1);
+/* PERL_CALLCONV void  Perl_sv_usepvn_mg(pTHX_ SV *sv, char *ptr, STRLEN len)
+                       __attribute__nonnull__(pTHX_1); */
 
 PERL_CALLCONV MGVTBL*  Perl_get_vtbl(pTHX_ int vtbl_id)
                        __attribute__warn_unused_result__;

diff --git a/sv.c b/sv.c
index 3c8fa77..85290bb 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -3885,7 +3885,7 @@ Perl_sv_setpv_mg(pTHX_ register SV *sv, register const char *ptr)
 }
 
 /*
-=for apidoc sv_usepvn
+=for apidoc sv_usepvn_flags
 
 Tells an SV to use C<ptr> to find its string value.  Normally the
 string is stored inside the SV but sv_usepvn allows the SV to use an
@@ -3894,14 +3894,14 @@ by C<malloc>.  The string length, C<len>, must be supplied.  This
 function will realloc (i.e. move) the memory pointed to by C<ptr>,
 so that pointer should not be freed or used by the programmer after
 giving it to sv_usepvn, and neither should any pointers from "behind"
-that pointer (e.g. ptr + 1) be used.  Does not handle 'set' magic.
-See C<sv_usepvn_mg>.
+that pointer (e.g. ptr + 1) be used.  If C<flags> & SV_SMAGIC is true, will
+call SvSETMAGIC.
 
 =cut
 */
 
 void
-Perl_sv_usepvn(pTHX_ register SV *sv, register char *ptr, register STRLEN len)
+Perl_sv_usepvn_flags(pTHX_ SV *sv, char *ptr, STRLEN len, U32 flags)
 {
     dVAR;
     STRLEN allocate;
@@ -3909,6 +3909,8 @@ Perl_sv_usepvn(pTHX_ register SV *sv, register char *ptr, register STRLEN len)
     SvUPGRADE(sv, SVt_PV);
     if (!ptr) {
        (void)SvOK_off(sv);
+       if (flags & SV_SMAGIC)
+           SvSETMAGIC(sv);
        return;
     }
     if (SvPVX_const(sv))
@@ -3933,21 +3935,8 @@ Perl_sv_usepvn(pTHX_ register SV *sv, register char *ptr, register STRLEN len)
     *SvEND(sv) = '\0';
     (void)SvPOK_only_UTF8(sv);         /* validate pointer */
     SvTAINT(sv);
-}
-
-/*
-=for apidoc sv_usepvn_mg
-
-Like C<sv_usepvn>, but also handles 'set' magic.
-
-=cut
-*/
-
-void
-Perl_sv_usepvn_mg(pTHX_ register SV *sv, register char *ptr, register STRLEN len)
-{
-    sv_usepvn(sv,ptr,len);
-    SvSETMAGIC(sv);
+    if (flags & SV_SMAGIC)
+       SvSETMAGIC(sv);
 }
 
 #ifdef PERL_OLD_COPY_ON_WRITE

diff --git a/sv.h b/sv.h
index 1a83cf3..e887497 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -1640,6 +1640,8 @@ Like C<sv_catsv> but doesn't process magic.
 
 #define sv_unref(sv)           sv_unref_flags(sv, 0)
 #define sv_force_normal(sv)    sv_force_normal_flags(sv, 0)
+#define sv_usepvn(sv, p, l)    sv_usepvn_flags(sv, p, l, 0)
+#define sv_usepvn_mg(sv, p, l) sv_usepvn_flags(sv, p, l, SV_SMAGIC)
 
 /* We are about to replace the SV's current value. So if it's copy on write
    we need to normalise it. Use the SV_COW_DROP_PV flag hint to say that