Use sv_catpvs(), newSVpvs(), newSVpvn(), newSVhek(), gv_stashpvs() and the

return value of sprintf().

Brought to you by the Campaign for the Elimination of strlen().
(And the elimination of accidental bugs due to typos in lengths of constant
strings.)

diff --git a/ext/B/B.pm b/ext/B/B.pm
index d9428ec..f7d22f1 100644 (file)
--- a/ext/B/B.pm
+++ b/ext/B/B.pm
@@ -7,7 +7,7 @@
 #
 package B;
 
-our $VERSION = '1.22';
+our $VERSION = '1.23';
 
 use XSLoader ();
 require Exporter;

diff --git a/ext/B/B.xs b/ext/B/B.xs
index 186237f..1d32c04 100644 (file)
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -331,35 +331,35 @@ make_mg_object(pTHX_ SV *arg, MAGIC *mg)
 static SV *
 cstring(pTHX_ SV *sv, bool perlstyle)
 {
-    SV *sstr = newSVpvn("", 0);
+    SV *sstr = newSVpvs("");
 
     if (!SvOK(sv))
-       sv_setpvn(sstr, "0", 1);
+       sv_setpvs(sstr, "0");
     else if (perlstyle && SvUTF8(sv)) {
        SV *tmpsv = sv_newmortal(); /* Temporary SV to feed sv_uni_display */
        const STRLEN len = SvCUR(sv);
        const char *s = sv_uni_display(tmpsv, sv, 8*len, UNI_DISPLAY_QQ);
-       sv_setpvn(sstr,"\"",1);
+       sv_setpvs(sstr,"\"");
        while (*s)
        {
            if (*s == '"')
-               sv_catpvn(sstr, "\\\"", 2);
+               sv_catpvs(sstr, "\\\"");
            else if (*s == '$')
-               sv_catpvn(sstr, "\\$", 2);
+               sv_catpvs(sstr, "\\$");
            else if (*s == '@')
-               sv_catpvn(sstr, "\\@", 2);
+               sv_catpvs(sstr, "\\@");
            else if (*s == '\\')
            {
                if (strchr("nrftax\\",*(s+1)))
                    sv_catpvn(sstr, s++, 2);
                else
-                   sv_catpvn(sstr, "\\\\", 2);
+                   sv_catpvs(sstr, "\\\\");
            }
            else /* should always be printable */
                sv_catpvn(sstr, s, 1);
            ++s;
        }
-       sv_catpv(sstr, "\"");
+       sv_catpvs(sstr, "\"");
        return sstr;
     }
     else
@@ -367,24 +367,24 @@ cstring(pTHX_ SV *sv, bool perlstyle)
        /* XXX Optimise? */
        STRLEN len;
        const char *s = SvPV(sv, len);
-       sv_catpv(sstr, "\"");
+       sv_catpvs(sstr, "\"");
        for (; len; len--, s++)
        {
            /* At least try a little for readability */
            if (*s == '"')
-               sv_catpv(sstr, "\\\"");
+               sv_catpvs(sstr, "\\\"");
            else if (*s == '\\')
-               sv_catpv(sstr, "\\\\");
+               sv_catpvs(sstr, "\\\\");
             /* trigraphs - bleagh */
             else if (!perlstyle && *s == '?' && len>=3 && s[1] == '?') {
                char escbuff[5]; /* to fit backslash, 3 octals + trailing \0 */
-                sprintf(escbuff, "\\%03o", '?');
-                sv_catpv(sstr, escbuff);
+               const STRLEN oct_len = my_sprintf(escbuff, "\\%03o", '?');
+                sv_catpvn(sstr, escbuff, oct_len);
             }
            else if (perlstyle && *s == '$')
-               sv_catpv(sstr, "\\$");
+               sv_catpvs(sstr, "\\$");
            else if (perlstyle && *s == '@')
-               sv_catpv(sstr, "\\@");
+               sv_catpvs(sstr, "\\@");
 #ifdef EBCDIC
            else if (isPRINT(*s))
 #else
@@ -392,30 +392,30 @@ cstring(pTHX_ SV *sv, bool perlstyle)
 #endif /* EBCDIC */
                sv_catpvn(sstr, s, 1);
            else if (*s == '\n')
-               sv_catpv(sstr, "\\n");
+               sv_catpvs(sstr, "\\n");
            else if (*s == '\r')
-               sv_catpv(sstr, "\\r");
+               sv_catpvs(sstr, "\\r");
            else if (*s == '\t')
-               sv_catpv(sstr, "\\t");
+               sv_catpvs(sstr, "\\t");
            else if (*s == '\a')
-               sv_catpv(sstr, "\\a");
+               sv_catpvs(sstr, "\\a");
            else if (*s == '\b')
-               sv_catpv(sstr, "\\b");
+               sv_catpvs(sstr, "\\b");
            else if (*s == '\f')
-               sv_catpv(sstr, "\\f");
+               sv_catpvs(sstr, "\\f");
            else if (!perlstyle && *s == '\v')
-               sv_catpv(sstr, "\\v");
+               sv_catpvs(sstr, "\\v");
            else
            {
                /* Don't want promotion of a signed -1 char in sprintf args */
                char escbuff[5]; /* to fit backslash, 3 octals + trailing \0 */
                const unsigned char c = (unsigned char) *s;
-               sprintf(escbuff, "\\%03o", c);
-               sv_catpv(sstr, escbuff);
+               const STRLEN oct_len = my_sprintf(escbuff, "\\%03o", c);
+               sv_catpvn(sstr, escbuff, oct_len);
            }
            /* XXX Add line breaks if string is long */
        }
-       sv_catpv(sstr, "\"");
+       sv_catpvs(sstr, "\"");
     }
     return sstr;
 }
@@ -423,13 +423,13 @@ cstring(pTHX_ SV *sv, bool perlstyle)
 static SV *
 cchar(pTHX_ SV *sv)
 {
-    SV *sstr = newSVpvn("'", 1);
+    SV *sstr = newSVpvs("'");
     const char *s = SvPV_nolen(sv);
 
     if (*s == '\'')
-       sv_catpvn(sstr, "\\'", 2);
+       sv_catpvs(sstr, "\\'");
     else if (*s == '\\')
-       sv_catpvn(sstr, "\\\\", 2);
+       sv_catpvs(sstr, "\\\\");
 #ifdef EBCDIC
     else if (isPRINT(*s))
 #else
@@ -437,29 +437,29 @@ cchar(pTHX_ SV *sv)
 #endif /* EBCDIC */
        sv_catpvn(sstr, s, 1);
     else if (*s == '\n')
-       sv_catpvn(sstr, "\\n", 2);
+       sv_catpvs(sstr, "\\n");
     else if (*s == '\r')
-       sv_catpvn(sstr, "\\r", 2);
+       sv_catpvs(sstr, "\\r");
     else if (*s == '\t')
-       sv_catpvn(sstr, "\\t", 2);
+       sv_catpvs(sstr, "\\t");
     else if (*s == '\a')
-       sv_catpvn(sstr, "\\a", 2);
+       sv_catpvs(sstr, "\\a");
     else if (*s == '\b')
-       sv_catpvn(sstr, "\\b", 2);
+       sv_catpvs(sstr, "\\b");
     else if (*s == '\f')
-       sv_catpvn(sstr, "\\f", 2);
+       sv_catpvs(sstr, "\\f");
     else if (*s == '\v')
-       sv_catpvn(sstr, "\\v", 2);
+       sv_catpvs(sstr, "\\v");
     else
     {
        /* no trigraph support */
        char escbuff[5]; /* to fit backslash, 3 octals + trailing \0 */
        /* Don't want promotion of a signed -1 char in sprintf args */
        unsigned char c = (unsigned char) *s;
-       sprintf(escbuff, "\\%03o", c);
-       sv_catpv(sstr, escbuff);
+       const STRLEN oct_len = my_sprintf(escbuff, "\\%03o", c);
+       sv_catpvn(sstr, escbuff, oct_len);
     }
-    sv_catpvn(sstr, "'", 1);
+    sv_catpvs(sstr, "'");
     return sstr;
 }
 
@@ -595,7 +595,7 @@ PROTOTYPES: DISABLE
 
 BOOT:
 {
-    HV *stash = gv_stashpvn("B", 1, GV_ADD);
+    HV *stash = gv_stashpvs("B", GV_ADD);
     AV *export_ok = perl_get_av("B::EXPORT_OK", GV_ADD);
     MY_CXT_INIT;
     specialsv_list[0] = Nullsv;
@@ -778,7 +778,7 @@ ppname(opnum)
     CODE:
        ST(0) = sv_newmortal();
        if (opnum >= 0 && opnum < PL_maxo) {
-           sv_setpvn(ST(0), "pp_", 3);
+           sv_setpvs(ST(0), "pp_");
            sv_catpv(ST(0), PL_op_name[opnum]);
        }
 
@@ -791,8 +791,8 @@ hash(sv)
        char hexhash[19]; /* must fit "0xffffffffffffffff" plus trailing \0 */
        const char *s = SvPV(sv, len);
        PERL_HASH(hash, s, len);
-       sprintf(hexhash, "0x%"UVxf, (UV)hash);
-       ST(0) = sv_2mortal(newSVpv(hexhash, 0));
+       len = my_sprintf(hexhash, "0x%"UVxf, (UV)hash);
+       ST(0) = sv_2mortal(newSVpvn(hexhash, len));
 
 #define cast_I32(foo) (I32)foo
 IV
@@ -895,11 +895,11 @@ OP_ppaddr(o)
        int i;
        SV *sv = sv_newmortal();
     CODE:
-       sv_setpvn(sv, "PL_ppaddr[OP_", 13);
+       sv_setpvs(sv, "PL_ppaddr[OP_");
        sv_catpv(sv, PL_op_name[o->op_type]);
        for (i=13; (STRLEN)i < SvCUR(sv); ++i)
            SvPVX(sv)[i] = toUPPER(SvPVX(sv)[i]);
-       sv_catpv(sv, "]");
+       sv_catpvs(sv, "]");
        ST(0) = sv;
 
 char *
@@ -1168,10 +1168,10 @@ PVOP_pv(o)
        {
            const short* const tbl = (short*)o->op_pv;
            const short entries = 257 + tbl[256];
-           ST(0) = sv_2mortal(newSVpv(o->op_pv, entries * sizeof(short)));
+           ST(0) = sv_2mortal(newSVpvn(o->op_pv, entries * sizeof(short)));
        }
        else if (o->op_type == OP_TRANS) {
-           ST(0) = sv_2mortal(newSVpv(o->op_pv, 256 * sizeof(short)));
+           ST(0) = sv_2mortal(newSVpvn(o->op_pv, 256 * sizeof(short)));
        }
        else
            ST(0) = sv_2mortal(newSVpv(o->op_pv, 0));
@@ -1667,7 +1667,11 @@ void
 GvNAME(gv)
        B::GV   gv
     CODE:
+#if PERL_VERSION >= 10
+       ST(0) = sv_2mortal(newSVhek(GvNAME_HEK(gv)));
+#else
        ST(0) = sv_2mortal(newSVpvn(GvNAME(gv), GvNAMELEN(gv)));
+#endif
 
 bool
 is_empty(gv)