Inline a subset of S_force_word() into the KEY_format section of Perl_yylex().

In code handling formats, Perl_yylex() calls S_force_word() at a point where
it has already done half the work that S_force_word() does. The validation
Perl_yylex() has already passed, along with the normalisation performed by
S_scan_word() mean that all it actually needs from S_force_word() is the
token forcing. Inlining these lines decouples the code.

1 files changed, 12 insertions, 2 deletions

diff --git a/toke.c b/toke.c
index 36b0796a42..05131b7ddc 100644
--- a/toke.c
+++ b/toke.c
@@ -8504,6 +8504,7 @@ Perl_yylex(pTHX)
 		expectation attrful;
 		bool have_name, have_proto;
 		const int key = tmp;
+                SV *format_name = NULL;
 
 #ifdef PERL_MAD
 		SV *tmpwhite = 0;
@@ -8538,6 +8539,8 @@ Perl_yylex(pTHX)
 		    if (PL_madskills)
 			nametoke = newSVpvn_flags(s, d - s, SvUTF8(PL_linestr));
 #endif
+                    if (key == KEY_format)
+			format_name = S_newSV_maybe_utf8(aTHX_ s, d - s);
 		    *PL_tokenbuf = '&';
 		    if (memchr(tmpbuf, ':', len) || key != KEY_sub
 		     || pad_findmy_pvn(
@@ -8585,8 +8588,15 @@ Perl_yylex(pTHX)
 		    s = d;
                     PERL_UNUSED_VAR(tboffset);
 #else
-		    if (have_name)
-			(void) force_word(tmpbuf, WORD, FALSE, TRUE);
+		    if (format_name) {
+                        start_force(PL_curforce);
+                        if (PL_madskills)
+                            curmad('X', newSVpvn(start,s-start));
+                        NEXTVAL_NEXTTOKE.opval
+                            = (OP*)newSVOP(OP_CONST,0, format_name);
+                        NEXTVAL_NEXTTOKE.opval->op_private |= OPpCONST_BARE;
+                        force_next(WORD);
+                    }
 #endif
 		    PREBLOCK(FORMAT);
 		}