Reinstate UTF8f

This format string allows char*s to be interpolated with the
utf8ness and length specified as well, avoiding the need to create
extra SVs:

Perl_croak(aTHX_ "Couldn't twiggle the twoggle in \"%"UTF8f"\"",
                  UTF8fARG(is_utf8, len, s));

This is the second attempt.

I screwed up in commits 1c8b67b38f0a5 and b3e714770ee1 because
I didn’t really understand how varargs functions receive their
arguments.

They are like structs, in that different members can be different
sizes.  So therefore both ends--the caller and the called--*must* get
the casts right, or the data will be corrupted.

The main mistake I made was to use %u in the format for the first
argument and then retrieve it as UV (a simple typo, I meant unsigned
int or U32--I don’t remember).

To be on the safe side, I added a UTF8fARG macro (after SVfARG), which
(unlike SVfARG) takes three arguments and casts them explicitly, mak-
ing it much harder to get this wrong at call sites.

1 files changed, 30 insertions, 40 deletions

diff --git a/toke.c b/toke.c
index 8f6eb44177..e4a79a9c47 100644
--- a/toke.c
+++ b/toke.c
@@ -553,16 +553,14 @@ S_no_op(pTHX_ const char *const what, char *s)
 		NOOP;
 	    if (t < PL_bufptr && isSPACE(*t))
 		Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
-			"\t(Do you need to predeclare %"SVf"?)\n",
-		    SVfARG(newSVpvn_flags(PL_oldoldbufptr, (STRLEN)(t - PL_oldoldbufptr),
-                                   SVs_TEMP | (UTF ? SVf_UTF8 : 0))));
+			"\t(Do you need to predeclare %"UTF8f"?)\n",
+		      UTF8fARG(UTF, t - PL_oldoldbufptr, PL_oldoldbufptr));
 	}
 	else {
 	    assert(s >= oldbp);
 	    Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
-		    "\t(Missing operator before %"SVf"?)\n",
-                    SVfARG(newSVpvn_flags(oldbp, (STRLEN)(s - oldbp),
-                                    SVs_TEMP | (UTF ? SVf_UTF8 : 0))));
+		    "\t(Missing operator before %"UTF8f"?)\n",
+		     UTF8fARG(UTF, s - oldbp, oldbp));
 	}
     }
     PL_bufptr = oldbp;
@@ -6506,9 +6504,8 @@ Perl_yylex(pTHX)
 				if (*t == ';'
                                        && get_cvn_flags(tmpbuf, len, UTF ? SVf_UTF8 : 0))
 				    Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
-						"You need to quote \"%"SVf"\"",
-						  SVfARG(newSVpvn_flags(tmpbuf, len, 
-                                                    SVs_TEMP | (UTF ? SVf_UTF8 : 0))));
+					"You need to quote \"%"UTF8f"\"",
+					 UTF8fARG(UTF, len, tmpbuf));
 			    }
 			}
 		}
@@ -6593,11 +6590,9 @@ Perl_yylex(pTHX)
 			PL_bufptr = PEEKSPACE(PL_bufptr); /* XXX can realloc */
        /* diag_listed_as: Scalar value @%s[%s] better written as $%s[%s] */
 			Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
-			    "Scalar value %"SVf" better written as $%"SVf,
-			    SVfARG(newSVpvn_flags(PL_bufptr, (STRLEN)(t-PL_bufptr),
-                                                SVs_TEMP | (UTF ? SVf_UTF8 : 0 ))),
-                            SVfARG(newSVpvn_flags(PL_bufptr+1, (STRLEN)(t-PL_bufptr-1),
-                                                SVs_TEMP | (UTF ? SVf_UTF8 : 0 ))));
+			 "Scalar value %"UTF8f" better written as $%"UTF8f,
+			  UTF8fARG(UTF, t-PL_bufptr, PL_bufptr),
+			  UTF8fARG(UTF, t-PL_bufptr-1, PL_bufptr+1));
 		    }
 		}
 	    }
@@ -7040,9 +7035,8 @@ Perl_yylex(pTHX)
 		    s = scan_word(s, PL_tokenbuf + len, sizeof PL_tokenbuf - len,
 				  TRUE, &morelen);
 		    if (!morelen)
-			Perl_croak(aTHX_ "Bad name after %"SVf"%s",
-                                        SVfARG(newSVpvn_flags(PL_tokenbuf, len,
-                                            (UTF ? SVf_UTF8 : 0) | SVs_TEMP )),
+			Perl_croak(aTHX_ "Bad name after %"UTF8f"%s",
+				UTF8fARG(UTF, len, PL_tokenbuf),
 				*s == '\'' ? "'" : "::");
 		    len += morelen;
 		    pkgname = 1;
@@ -7069,9 +7063,8 @@ Perl_yylex(pTHX)
 		    if (ckWARN(WARN_BAREWORD)
 			&& ! gv_fetchpvn_flags(PL_tokenbuf, len, UTF ? SVf_UTF8 : 0, SVt_PVHV))
 			Perl_warner(aTHX_ packWARN(WARN_BAREWORD),
-		  	    "Bareword \"%"SVf"\" refers to nonexistent package",
-			     SVfARG(newSVpvn_flags(PL_tokenbuf, len,
-                                        (UTF ? SVf_UTF8 : 0) | SVs_TEMP)));
+		  	  "Bareword \"%"UTF8f"\" refers to nonexistent package",
+			   UTF8fARG(UTF, len, PL_tokenbuf));
 		    len -= 2;
 		    PL_tokenbuf[len] = '\0';
 		    gv = NULL;
@@ -7261,10 +7254,11 @@ Perl_yylex(pTHX)
 
 		if (cv) {
 		    if (lastchar == '-' && penultchar != '-') {
-                        const SV *tmpsv = newSVpvn_flags( PL_tokenbuf, len ? len : strlen(PL_tokenbuf), (UTF ? SVf_UTF8 : 0) | SVs_TEMP );
+			const STRLEN l = len ? len : strlen(PL_tokenbuf);
  			Perl_ck_warner_d(aTHX_ packWARN(WARN_AMBIGUOUS),
-				"Ambiguous use of -%"SVf" resolved as -&%"SVf"()",
-				SVfARG(tmpsv), SVfARG(tmpsv));
+			    "Ambiguous use of -%"UTF8f" resolved as -&%"UTF8f"()",
+			     UTF8fARG(UTF, l, PL_tokenbuf),
+			     UTF8fARG(UTF, l, PL_tokenbuf));
                     }
 		    /* Check for a constant sub */
 		    if ((sv = cv_const_sv(cv))) {
@@ -7441,10 +7435,10 @@ Perl_yylex(pTHX)
 		if ((lastchar == '*' || lastchar == '%' || lastchar == '&')
 		 && saw_infix_sigil) {
 		    Perl_ck_warner_d(aTHX_ packWARN(WARN_AMBIGUOUS),
-				     "Operator or semicolon missing before %c%"SVf,
-				     lastchar, SVfARG(newSVpvn_flags(PL_tokenbuf,
-                                                    strlen(PL_tokenbuf),
-                                                    SVs_TEMP | (UTF ? SVf_UTF8 : 0))));
+				     "Operator or semicolon missing before %c%"UTF8f,
+				     lastchar,
+				     UTF8fARG(UTF, strlen(PL_tokenbuf),
+					      PL_tokenbuf));
 		    Perl_ck_warner_d(aTHX_ packWARN(WARN_AMBIGUOUS),
 				     "Ambiguous use of %c resolved as operator %c",
 				     lastchar, lastchar);
@@ -7604,9 +7598,8 @@ Perl_yylex(pTHX)
 		    goto just_a_word;
 		}
 		if (!tmp)
-		    Perl_croak(aTHX_ "CORE::%"SVf" is not a keyword",
-                                    SVfARG(newSVpvn_flags(PL_tokenbuf, len,
-                                                (UTF ? SVf_UTF8 : 0) | SVs_TEMP)));
+		    Perl_croak(aTHX_ "CORE::%"UTF8f" is not a keyword",
+				      UTF8fARG(UTF, len, PL_tokenbuf));
 		if (tmp < 0)
 		    tmp = -tmp;
 		else if (tmp == KEY_require || tmp == KEY_do
@@ -8162,11 +8155,9 @@ Perl_yylex(pTHX)
 		    && !(t[0] == ':' && t[1] == ':')
 		    && !keyword(s, d-s, 0)
 		) {
-		    SV *tmpsv = newSVpvn_flags(s, (STRLEN)(d-s),
-                                                SVs_TEMP | (UTF ? SVf_UTF8 : 0));
 		    Perl_warner(aTHX_ packWARN(WARN_PRECEDENCE),
-			   "Precedence problem: open %"SVf" should be open(%"SVf")",
-			    SVfARG(tmpsv), SVfARG(tmpsv));
+		       "Precedence problem: open %"UTF8f" should be open(%"UTF8f")",
+			UTF8fARG(UTF, d-s, s), UTF8fARG(UTF, d-s, s));
 		}
 	    }
 	    LOP(OP_OPEN,XTERM);
@@ -9018,9 +9009,9 @@ S_pending_ident(pTHX)
         {
             /* Downgraded from fatal to warning 20000522 mjd */
             Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
-			"Possible unintended interpolation of %"SVf" in string",
-			SVfARG(newSVpvn_flags(PL_tokenbuf, tokenbuf_len,
-                                        SVs_TEMP | ( UTF ? SVf_UTF8 : 0 ))));
+			"Possible unintended interpolation of %"UTF8f
+			" in string",
+			UTF8fARG(UTF, tokenbuf_len, PL_tokenbuf));
         }
     }
 
@@ -11411,9 +11402,8 @@ Perl_yyerror_pvn(pTHX_ const char *const s, STRLEN len, U32 flags)
     Perl_sv_catpvf(aTHX_ msg, " at %s line %"IVdf", ",
         OutCopFILE(PL_curcop), (IV)CopLINE(PL_curcop));
     if (context)
-	Perl_sv_catpvf(aTHX_ msg, "near \"%"SVf"\"\n",
-                            SVfARG(newSVpvn_flags(context, contlen,
-                                        SVs_TEMP | (UTF ? SVf_UTF8 : 0))));
+	Perl_sv_catpvf(aTHX_ msg, "near \"%"UTF8f"\"\n",
+			     UTF8fARG(UTF, contlen, context));
     else
 	Perl_sv_catpvf(aTHX_ msg, "%"SVf"\n", SVfARG(where_sv));
     if (PL_multi_start < PL_multi_end && (U32)(CopLINE(PL_curcop) - PL_multi_end) <= 1) {