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.)

2 files changed, 51 insertions, 47 deletions

diff --git a/ext/B/B.pm b/ext/B/B.pm
index d9428ec7ad..f7d22f1147 100644
--- 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 186237feee..1d32c04814 100644
--- 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)