This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
sv.c: add sv_setpv_bufsize() and SvPVCLEAR()
authorYves Orton <demerphq@gmail.com>
Wed, 19 Oct 2016 08:40:29 +0000 (10:40 +0200)
committerYves Orton <demerphq@gmail.com>
Wed, 19 Oct 2016 11:27:59 +0000 (13:27 +0200)
The first can be used to wrap several SVPV steps into
a single sub, and a wrapper macro which is the equivalent
of

   $s= "";

but is optimized in various ways.

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

index 46426b6..3e0e844 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1566,6 +1566,7 @@ Apd       |SV*    |sv_setref_pvn  |NN SV *const rv|NULLOK const char *const classname \
                                |NN const char *const pv|const STRLEN n
 Apd    |void   |sv_setpv       |NN SV *const sv|NULLOK const char *const ptr
 Apd    |void   |sv_setpvn      |NN SV *const sv|NULLOK const char *const ptr|const STRLEN len
+Apd    |char  *|sv_setpv_bufsize|NN SV *const sv|const STRLEN cur|const STRLEN len
 Xp     |void   |sv_sethek      |NN SV *const sv|NULLOK const HEK *const hek
 Apmdb  |void   |sv_setsv       |NN SV *dstr|NULLOK SV *sstr
 Apmdb  |void   |sv_taint       |NN SV* sv
diff --git a/embed.h b/embed.h
index 5df381c..7ccf06f 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define sv_setnv(a,b)          Perl_sv_setnv(aTHX_ a,b)
 #define sv_setnv_mg(a,b)       Perl_sv_setnv_mg(aTHX_ a,b)
 #define sv_setpv(a,b)          Perl_sv_setpv(aTHX_ a,b)
+#define sv_setpv_bufsize(a,b,c)        Perl_sv_setpv_bufsize(aTHX_ a,b,c)
 #define sv_setpv_mg(a,b)       Perl_sv_setpv_mg(aTHX_ a,b)
 #ifndef PERL_IMPLICIT_CONTEXT
 #define sv_setpvf              Perl_sv_setpvf
diff --git a/proto.h b/proto.h
index 701dc9e..228e84e 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -3251,6 +3251,9 @@ PERL_CALLCONV void        Perl_sv_setnv_mg(pTHX_ SV *const sv, const NV num);
 PERL_CALLCONV void     Perl_sv_setpv(pTHX_ SV *const sv, const char *const ptr);
 #define PERL_ARGS_ASSERT_SV_SETPV      \
        assert(sv)
+PERL_CALLCONV char  *  Perl_sv_setpv_bufsize(pTHX_ SV *const sv, const STRLEN cur, const STRLEN len);
+#define PERL_ARGS_ASSERT_SV_SETPV_BUFSIZE      \
+       assert(sv)
 PERL_CALLCONV void     Perl_sv_setpv_mg(pTHX_ SV *const sv, const char *const ptr);
 #define PERL_ARGS_ASSERT_SV_SETPV_MG   \
        assert(sv)
diff --git a/sv.c b/sv.c
index dd0b3d4..e8fab62 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -4875,6 +4875,35 @@ Perl_sv_setsv_cow(pTHX_ SV *dstr, SV *sstr)
 #endif
 
 /*
+=for apidoc sv_setpv_bufsize
+
+Sets the SV to be a string of cur bytes length, with at least
+len bytes available. Ensures that there is a null byte at SvEND.
+Returns a char * pointer to the SvPV buffer.
+
+=cut
+*/
+
+char *
+Perl_sv_setpv_bufsize(pTHX_ SV *const sv, const STRLEN cur, const STRLEN len)
+{
+    char *pv;
+
+    PERL_ARGS_ASSERT_SV_SETPV_BUFSIZE;
+
+    SV_CHECK_THINKFIRST_COW_DROP(sv);
+    SvUPGRADE(sv, SVt_PV);
+    pv = SvGROW(sv, len + 1);
+    SvCUR_set(sv, cur);
+    *(SvEND(sv))= '\0';
+    (void)SvPOK_only_UTF8(sv);                /* validate pointer */
+
+    SvTAINT(sv);
+    if (SvTYPE(sv) == SVt_PVCV) CvAUTOLOAD_off(sv);
+    return pv;
+}
+
+/*
 =for apidoc sv_setpvn
 
 Copies a string (possibly containing embedded C<NUL> characters) into an SV.
diff --git a/sv.h b/sv.h
index 7f43f3b..d45a4a9 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -2035,9 +2035,14 @@ Returns a pointer to the character
 buffer.  SV must be of type >= C<SVt_PV>.  One
 alternative is to call C<sv_grow> if you are not sure of the type of SV.
 
+=for apidoc Am|char *|SvPVCLEAR|SV* sv
+Ensures that sv is a SVt_PV and that its SvCUR is 0, and that it is
+properly null terminated. Equivalent to sv_setpvs(""), but more efficient.
+
 =cut
 */
 
+#define SvPVCLEAR(sv) sv_setpv_bufsize(sv,0,0)
 #define SvSHARE(sv) PL_sharehook(aTHX_ sv)
 #define SvLOCK(sv) PL_lockhook(aTHX_ sv)
 #define SvUNLOCK(sv) PL_unlockhook(aTHX_ sv)