perl/perl-5.16.1-perl-105924-require-1-2.patch
2012-09-21 11:00:34 +02:00

117 lines
2.9 KiB
Diff
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

From d546938a7c8b111c463b733910db885b24724b42 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Thu, 20 Sep 2012 06:24:25 -0700
Subject: [PATCH] require 1 << 2
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Port to 5.16.1:
commit c31f6d3b869d78bbd101e694fd3b384b47a77f6d
Author: Father Chrysostomos <sprout@cpan.org>
Date: Thu Sep 20 06:24:25 2012 -0700
[perl #105924] require 1 << 2
Setting PL_expect after force_next has no effect, as force_next
(called by force_version and force_word) picks up the current value of
PL_expect and arranges for it to be reset thereto after the forced
token is force-fed to the parser.
The KEY_require case should be setting PL_expect to XTERM (as it
already does) when there is no forced token (version or bareword),
because we expect a term after require, but to XOPERATOR when
there is a forced token, because we expect an operator after that
forced token.
Since the PL_expect assignment has no effect after force_next, we can
set it to XOPERATOR before calling potentially calling force_next, and
then to XTERM afterwards.
Loop exits had the same bug, so this fixes them all.
---
t/base/lex.t | 10 +++++++++-
toke.c | 6 ++++++
2 files changed, 15 insertions(+), 1 deletion(-)
diff --git a/t/base/lex.t b/t/base/lex.t
index ce16ef1..c2a6cc3 100644
--- a/t/base/lex.t
+++ b/t/base/lex.t
@@ -1,6 +1,6 @@
#!./perl
-print "1..57\n";
+print "1..63\n";
$x = 'x';
@@ -273,3 +273,11 @@ $test++;
@a = (1,2,3);
print "not " unless($a[~~2] == 3);
print "ok 57\n";
+
+$test = 58;
+for(qw< require goto last next redo dump >) {
+ eval "sub { $_ foo << 2 }";
+ print "not " if $@;
+ print "ok ", $test++, " - [perl #105924] $_ WORD << ...\n";
+ print "# $@" if $@;
+}
diff --git a/toke.c b/toke.c
index 1d18550..aa2c3b6 100644
--- a/toke.c
+++ b/toke.c
@@ -7344,6 +7344,7 @@ Perl_yylex(pTHX)
UNI(OP_DBMCLOSE);
case KEY_dump:
+ PL_expect = XOPERATOR;
s = force_word(s,WORD,TRUE,FALSE,FALSE);
LOOPX(OP_DUMP);
@@ -7476,6 +7477,7 @@ Perl_yylex(pTHX)
LOP(OP_GREPSTART, XREF);
case KEY_goto:
+ PL_expect = XOPERATOR;
s = force_word(s,WORD,TRUE,FALSE,FALSE);
LOOPX(OP_GOTO);
@@ -7598,6 +7600,7 @@ Perl_yylex(pTHX)
LOP(OP_KILL,XTERM);
case KEY_last:
+ PL_expect = XOPERATOR;
s = force_word(s,WORD,TRUE,FALSE,FALSE);
LOOPX(OP_LAST);
@@ -7695,6 +7698,7 @@ Perl_yylex(pTHX)
OPERATOR(MY);
case KEY_next:
+ PL_expect = XOPERATOR;
s = force_word(s,WORD,TRUE,FALSE,FALSE);
LOOPX(OP_NEXT);
@@ -7880,6 +7884,7 @@ Perl_yylex(pTHX)
case KEY_require:
s = SKIPSPACE1(s);
+ PL_expect = XOPERATOR;
if (isDIGIT(*s)) {
s = force_version(s, FALSE);
}
@@ -7911,6 +7916,7 @@ Perl_yylex(pTHX)
UNI(OP_RESET);
case KEY_redo:
+ PL_expect = XOPERATOR;
s = force_word(s,WORD,TRUE,FALSE,FALSE);
LOOPX(OP_REDO);
--
1.7.11.4