In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/8abd6374ff4d4e3baa6f4befa3b08b59cfe6dce5?hp=d82e2a6d8f2cc6469125270842b1e69ea0d72831>
- Log -----------------------------------------------------------------
commit 8abd6374ff4d4e3baa6f4befa3b08b59cfe6dce5
Merge: d82e2a6 d6a4f4b
Author: Nicholas Clark <n...@ccl4.org>
Date: Tue Jun 11 15:04:40 2013 +0200
Merge the refactoring of toke.c's S_force_word.
The C level changes are invisible to anything outside of toke.c.
Nothing should notice this change.
commit d6a4f4b5319be6b18d1a7e66172237c8b6137820
Author: Nicholas Clark <n...@ccl4.org>
Date: Wed Feb 27 16:09:29 2013 +0100
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.
M toke.c
commit 345b3785326c7725d2f52bfa4a802d2428eb8a17
Author: Brian Fraser <frase...@gmail.com>
Date: Tue Feb 26 17:07:59 2013 -0300
toke.c: Remove the allow_initial_tick hack from S_force_word.
Over the years, every caller which used this hack had it progressively
turned off. Prior to this commit, only one call remained, which
ostensibly handled this case:
format 'STDOUT = ...
However, turns out that even there it was superflous, since a scan_word
a dozen lines before will've already turned all ticks into double
colons.
M embed.fnc
M embed.h
M proto.h
M toke.c
commit 7196fc2f2d32b6d967837833bdf1bccf50f7f714
Author: Brian Fraser <frase...@gmail.com>
Date: Tue Feb 26 20:07:41 2013 -0300
Eliminate the last call to S_force_word() passing allow_initial_tick as
TRUE.
Turns out that that final place using the allow_tick hack could get a tick,
because it was using the original buffer, rather than the already processed
identifier from scan_word.
M toke.c
commit 1a01716a33e6e32e48b6631819e8f1c4bee8d0bd
Author: Nicholas Clark <n...@ccl4.org>
Date: Wed Feb 27 10:50:46 2013 +0100
Test that C<format ::Foo> is identical to C<format Foo>
This wasn't being explicitly tested.
M t/comp/parser.t
commit a20e6aaed858bacbfb2592e4d1ac5c0d3983de0c
Author: Brian Fraser <frase...@gmail.com>
Date: Tue Feb 26 20:07:41 2013 -0300
Test that C<format 'Foo> is identical to C<format Foo>
When declaring a format, using a leading package separator requires careful
handling in the parser, to avoid confusion with a subroutine of the same
name.
M t/comp/parser.t
-----------------------------------------------------------------------
Summary of changes:
embed.fnc | 2 +-
embed.h | 2 +-
proto.h | 2 +-
t/comp/parser.t | 24 +++++++++++++++++++++++-
toke.c | 46 +++++++++++++++++++++++++++-------------------
5 files changed, 53 insertions(+), 23 deletions(-)
diff --git a/embed.fnc b/embed.fnc
index 3551161..6e6f2cd 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -2192,7 +2192,7 @@ s |void |force_next |I32 type
s |char* |force_version |NN char *s|int guessing
s |char* |force_strict_version |NN char *s
s |char* |force_word |NN char *start|int token|int check_keyword \
- |int allow_pack|int allow_tick
+ |int allow_pack
s |SV* |tokeq |NN SV *sv
s |void |readpipe_override|
sR |char* |scan_const |NN char *start
diff --git a/embed.h b/embed.h
index 9446875..f2003af 100644
--- a/embed.h
+++ b/embed.h
@@ -1597,7 +1597,7 @@
#define force_next(a) S_force_next(aTHX_ a)
#define force_strict_version(a) S_force_strict_version(aTHX_ a)
#define force_version(a,b) S_force_version(aTHX_ a,b)
-#define force_word(a,b,c,d,e) S_force_word(aTHX_ a,b,c,d,e)
+#define force_word(a,b,c,d) S_force_word(aTHX_ a,b,c,d)
#define get_and_check_backslash_N_name(a,b)
S_get_and_check_backslash_N_name(aTHX_ a,b)
#define incline(a) S_incline(aTHX_ a)
#define intuit_method(a,b,c) S_intuit_method(aTHX_ a,b,c)
diff --git a/proto.h b/proto.h
index cad9f2e..3cebd4e 100644
--- a/proto.h
+++ b/proto.h
@@ -7216,7 +7216,7 @@ STATIC char* S_force_version(pTHX_ char *s, int
guessing)
#define PERL_ARGS_ASSERT_FORCE_VERSION \
assert(s)
-STATIC char* S_force_word(pTHX_ char *start, int token, int check_keyword,
int allow_pack, int allow_tick)
+STATIC char* S_force_word(pTHX_ char *start, int token, int check_keyword,
int allow_pack)
__attribute__nonnull__(pTHX_1);
#define PERL_ARGS_ASSERT_FORCE_WORD \
assert(start)
diff --git a/t/comp/parser.t b/t/comp/parser.t
index 7c0db7f..fa11de9 100644
--- a/t/comp/parser.t
+++ b/t/comp/parser.t
@@ -3,7 +3,7 @@
# Checks if the parser behaves correctly in edge cases
# (including weird syntax errors)
-print "1..154\n";
+print "1..156\n";
sub failed {
my ($got, $expected, $name) = @_;
@@ -450,6 +450,28 @@ for my $pkg(()){}
$pkg = 3;
is $pkg, 3, '[perl #114942] for my $foo()){} $foo';
+# Check that format 'Foo still works after removing the hack from
+# force_word
+$test++;
+format 'one =
+ok @<< - format 'foo still works
+$test
+.
+{
+ local $~ = "one";
+ write();
+}
+
+$test++;
+format ::two =
+ok @<< - format ::foo still works
+$test
+.
+{
+ local $~ = "two";
+ write();
+}
+
# Add new tests HERE (above this line)
# bug #74022: Loop on characters in \p{OtherIDContinue}
diff --git a/toke.c b/toke.c
index d3bc457..05131b7 100644
--- a/toke.c
+++ b/toke.c
@@ -2114,7 +2114,7 @@ S_newSV_maybe_utf8(pTHX_ const char *const start, STRLEN
len)
*/
STATIC char *
-S_force_word(pTHX_ char *start, int token, int check_keyword, int allow_pack,
int allow_initial_tick)
+S_force_word(pTHX_ char *start, int token, int check_keyword, int allow_pack)
{
dVAR;
char *s;
@@ -2125,8 +2125,7 @@ S_force_word(pTHX_ char *start, int token, int
check_keyword, int allow_pack, in
start = SKIPSPACE1(start);
s = start;
if (isIDFIRST_lazy_if(s,UTF) ||
- (allow_pack && *s == ':') ||
- (allow_initial_tick && *s == '\'') )
+ (allow_pack && *s == ':') )
{
s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, allow_pack, &len);
if (check_keyword) {
@@ -4557,12 +4556,12 @@ S_tokenize_use(pTHX_ int is_use, char *s) {
force_next(WORD);
}
else if (*s == 'v') {
- s = force_word(s,WORD,FALSE,TRUE,FALSE);
+ s = force_word(s,WORD,FALSE,TRUE);
s = force_version(s, FALSE);
}
}
else {
- s = force_word(s,WORD,FALSE,TRUE,FALSE);
+ s = force_word(s,WORD,FALSE,TRUE);
s = force_version(s, FALSE);
}
pl_yylval.ival = is_use;
@@ -5554,7 +5553,7 @@ Perl_yylex(pTHX)
s++;
if (strnEQ(s,"=>",2)) {
- s = force_word(PL_bufptr,WORD,FALSE,FALSE,FALSE);
+ s = force_word(PL_bufptr,WORD,FALSE,FALSE);
DEBUG_T( { printbuf("### Saw unary minus before =>, forcing
word %s\n", s); } );
OPERATOR('-'); /* unary minus */
}
@@ -5626,7 +5625,7 @@ Perl_yylex(pTHX)
s++;
s = SKIPSPACE1(s);
if (isIDFIRST_lazy_if(s,UTF)) {
- s = force_word(s,METHOD,FALSE,TRUE,FALSE);
+ s = force_word(s,METHOD,FALSE,TRUE);
TOKEN(ARROW);
}
else if (*s == '$')
@@ -5989,7 +5988,7 @@ Perl_yylex(pTHX)
d++;
if (*d == '}') {
const char minus = (PL_tokenbuf[0] == '-');
- s = force_word(s + minus, WORD, FALSE, TRUE, FALSE);
+ s = force_word(s + minus, WORD, FALSE, TRUE);
if (minus)
force_next('-');
}
@@ -7749,7 +7748,7 @@ Perl_yylex(pTHX)
case KEY_dump:
PL_expect = XOPERATOR;
- s = force_word(s,WORD,TRUE,FALSE,FALSE);
+ s = force_word(s,WORD,TRUE,FALSE);
LOOPX(OP_DUMP);
case KEY_else:
@@ -7882,7 +7881,7 @@ Perl_yylex(pTHX)
case KEY_goto:
PL_expect = XOPERATOR;
- s = force_word(s,WORD,TRUE,FALSE,FALSE);
+ s = force_word(s,WORD,TRUE,FALSE);
LOOPX(OP_GOTO);
case KEY_gmtime:
@@ -8008,7 +8007,7 @@ Perl_yylex(pTHX)
case KEY_last:
PL_expect = XOPERATOR;
- s = force_word(s,WORD,TRUE,FALSE,FALSE);
+ s = force_word(s,WORD,TRUE,FALSE);
LOOPX(OP_LAST);
case KEY_lc:
@@ -8116,7 +8115,7 @@ Perl_yylex(pTHX)
case KEY_next:
PL_expect = XOPERATOR;
- s = force_word(s,WORD,TRUE,FALSE,FALSE);
+ s = force_word(s,WORD,TRUE,FALSE);
LOOPX(OP_NEXT);
case KEY_ne:
@@ -8200,7 +8199,7 @@ Perl_yylex(pTHX)
LOP(OP_PACK,XTERM);
case KEY_package:
- s = force_word(s,WORD,FALSE,TRUE,FALSE);
+ s = force_word(s,WORD,FALSE,TRUE);
s = SKIPSPACE1(s);
s = force_strict_version(s);
PL_lex_expect = XBLOCK;
@@ -8303,7 +8302,7 @@ Perl_yylex(pTHX)
|| (s = force_version(s, TRUE), *s == 'v'))
{
*PL_tokenbuf = '\0';
- s = force_word(s,WORD,TRUE,TRUE,FALSE);
+ s = force_word(s,WORD,TRUE,TRUE);
if (isIDFIRST_lazy_if(PL_tokenbuf,UTF))
gv_stashpvn(PL_tokenbuf, strlen(PL_tokenbuf),
GV_ADD | (UTF ? SVf_UTF8 : 0));
@@ -8328,7 +8327,7 @@ Perl_yylex(pTHX)
case KEY_redo:
PL_expect = XOPERATOR;
- s = force_word(s,WORD,TRUE,FALSE,FALSE);
+ s = force_word(s,WORD,TRUE,FALSE);
LOOPX(OP_REDO);
case KEY_rename:
@@ -8469,7 +8468,7 @@ Perl_yylex(pTHX)
checkcomma(s,PL_tokenbuf,"subroutine name");
s = SKIPSPACE1(s);
PL_expect = XTERM;
- s = force_word(s,WORD,TRUE,TRUE,FALSE);
+ s = force_word(s,WORD,TRUE,TRUE);
LOP(OP_SORT,XREF);
case KEY_split:
@@ -8505,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;
@@ -8539,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(
@@ -8586,9 +8588,15 @@ Perl_yylex(pTHX)
s = d;
PERL_UNUSED_VAR(tboffset);
#else
- if (have_name)
- (void) force_word(PL_oldbufptr + tboffset, WORD,
- FALSE, TRUE, 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);
}
--
Perl5 Master Repository
