savepv(SvPV(sv,n_a)) is common, and creates an unnecessary call to

strlen(). Add savesvpv(sv), which gets the length from the SV,
and returns a copy of its PV.

p4raw-id: //depot/perl@23772

diff --git a/embed.fnc b/embed.fnc
index d7336b7..231dc14 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1490,4 +1490,6 @@ Ap        |GV*    |gv_fetchpvn_flags|const char* name|STRLEN len|I32 flags|I32 sv_type
 Ap     |GV*    |gv_fetchsv|SV *name|I32 flags|I32 sv_type
 dp     |bool   |is_gv_magical_sv|SV *name|U32 flags
 
+Apd    |char*  |savesvpv       |SV* sv
+
 END_EXTERN_C

diff --git a/embed.h b/embed.h
index dacd251..9d22e8d 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -2283,6 +2283,7 @@
 #ifdef PERL_CORE
 #define is_gv_magical_sv       Perl_is_gv_magical_sv
 #endif
+#define savesvpv               Perl_savesvpv
 #define ck_anoncode            Perl_ck_anoncode
 #define ck_bitop               Perl_ck_bitop
 #define ck_concat              Perl_ck_concat
@@ -4903,6 +4904,7 @@
 #ifdef PERL_CORE
 #define is_gv_magical_sv(a,b)  Perl_is_gv_magical_sv(aTHX_ a,b)
 #endif
+#define savesvpv(a)            Perl_savesvpv(aTHX_ a)
 #define ck_anoncode(a)         Perl_ck_anoncode(aTHX_ a)
 #define ck_bitop(a)            Perl_ck_bitop(aTHX_ a)
 #define ck_concat(a)           Perl_ck_concat(aTHX_ a)

diff --git a/global.sym b/global.sym
index cdd5e05..6c004bb 100644 (file)
--- a/global.sym
+++ b/global.sym
@@ -675,3 +675,4 @@ Perl_hv_clear_placeholders
 Perl_hv_scalar
 Perl_gv_fetchpvn_flags
 Perl_gv_fetchsv
+Perl_savesvpv

diff --git a/mg.c b/mg.c
index 255e208..c24bf6d 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -2118,7 +2118,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
        if (PL_inplace)
            Safefree(PL_inplace);
        if (SvOK(sv))
-           PL_inplace = savepv(SvPV(sv,len));
+           PL_inplace = savesvpv(sv);
        else
            PL_inplace = Nullch;
        break;
@@ -2130,7 +2130,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
            }
            if (SvOK(sv)) {
                TAINT_PROPER("assigning to $^O");
-               PL_osname = savepv(SvPV(sv,len));
+               PL_osname = savesvpv(sv);
            }
        }
        else if (strEQ(mg->mg_ptr, "\017PEN")) {
@@ -2206,12 +2206,12 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
        break;
     case '^':
        Safefree(IoTOP_NAME(GvIOp(PL_defoutgv)));
-       IoTOP_NAME(GvIOp(PL_defoutgv)) = s = savepv(SvPV(sv,len));
+       IoTOP_NAME(GvIOp(PL_defoutgv)) = s = savesvpv(sv);
        IoTOP_GV(GvIOp(PL_defoutgv)) = gv_fetchsv(sv,TRUE, SVt_PVIO);
        break;
     case '~':
        Safefree(IoFMT_NAME(GvIOp(PL_defoutgv)));
-       IoFMT_NAME(GvIOp(PL_defoutgv)) = s = savepv(SvPV(sv,len));
+       IoFMT_NAME(GvIOp(PL_defoutgv)) = s = savesvpv(sv);
        IoFMT_GV(GvIOp(PL_defoutgv)) = gv_fetchsv(sv,TRUE, SVt_PVIO);
        break;
     case '=':
@@ -2269,7 +2269,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
     case '#':
        if (PL_ofmt)
            Safefree(PL_ofmt);
-       PL_ofmt = savepv(SvPV(sv,len));
+       PL_ofmt = savesvpv(sv);
        break;
     case '[':
        PL_compiling.cop_arybase = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);

diff --git a/pp_sys.c b/pp_sys.c
index e125fb9..78cf48b 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1340,7 +1340,7 @@ PP(pp_leavewrite)
                topgv = gv_fetchsv(topname, FALSE, SVt_PVFM);
                if ((topgv && GvFORM(topgv)) ||
                  !gv_fetchpv("top",FALSE,SVt_PVFM))
-                   IoTOP_NAME(io) = savepv(SvPVX(topname));
+                   IoTOP_NAME(io) = savesvpv(topname);
                else
                    IoTOP_NAME(io) = savepv("top");
            }

diff --git a/proto.h b/proto.h
index 8c998dd..64a6185 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -1429,4 +1429,6 @@ PERL_CALLCONV GV* Perl_gv_fetchpvn_flags(pTHX_ const char* name, STRLEN len, I32
 PERL_CALLCONV GV*      Perl_gv_fetchsv(pTHX_ SV *name, I32 flags, I32 sv_type);
 PERL_CALLCONV bool     Perl_is_gv_magical_sv(pTHX_ SV *name, U32 flags);
 
+PERL_CALLCONV char*    Perl_savesvpv(pTHX_ SV* sv);
+
 END_EXTERN_C

diff --git a/regcomp.c b/regcomp.c
index bcfb2a3..6b34346 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -4863,7 +4863,7 @@ Perl_regprop(pTHX_ SV *sv, regnode *o)
                }
 
                {
-                   char *s = savepv(SvPVX(lv));
+                   char *s = savesvpv(lv);
                    char *origs = s;
                
                    while(*s && *s != '\n') s++;

diff --git a/universal.c b/universal.c
index 525ae44..829952a 100644 (file)
--- a/universal.c
+++ b/universal.c
@@ -602,7 +602,7 @@ XS(XS_version_qv)
            }
            else
            {
-               version = savepv(SvPV_nolen(ver));
+               version = savesvpv(ver);
            }
            (void)scan_version(version,vs,TRUE);
            Safefree(version);

diff --git a/util.c b/util.c
index e99c6af..3598e7b 100644 (file)
--- a/util.c
+++ b/util.c
@@ -819,6 +819,25 @@ Perl_savesharedpv(pTHX_ const char *pv)
     return strcpy(newaddr,pv);
 }
 
+/*
+=for apidoc savesvpv
+
+A version of C<savepv()>/C<savepvn() which gets the string to duplicate from
+the passed in SV using C<SvPV()>
+
+=cut
+*/
+
+char *
+Perl_savesvpv(pTHX_ SV *sv)
+{
+    STRLEN len;
+    const char *pv = SvPV(sv, len);
+    register char *newaddr;
+
+    New(903,newaddr,++len,char);
+    return CopyD(pv,newaddr,len,char);
+}
 
 
 /* the SV for Perl_form() and mess() is not kept in an arena */
@@ -3976,8 +3995,7 @@ Perl_upg_version(pTHX_ SV *ver)
 #endif
     else /* must be a string or something like a string */
     {
-       STRLEN n_a;
-       version = savepv(SvPV(ver,n_a));
+       version = savesvpv(ver);
     }
     (void)scan_version(version, ver, qv);
     Safefree(version);