Inline a subset of S_force_word() into the KEY_format section of Perl_yylex().
authorNicholas Clark <nick@ccl4.org>
Wed, 27 Feb 2013 15:09:29 +0000 (16:09 +0100)
committerNicholas Clark <nick@ccl4.org>
Tue, 11 Jun 2013 13:03:47 +0000 (15:03 +0200)
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.

toke.c

diff --git a/toke.c b/toke.c
index 36b0796..05131b7 100644 (file)
--- 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);
                }