From: Dave Mitchell <davem@fdisolutions.com>
Date: Sat, 19 Apr 2003 20:06:51 +0000 (+0100)
Subject: Re: [PATCH] [perl #21875] Hash ref transformed as a list
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=abc667d141be9d100fa9e0402f7809147d1f69b9;p=p5sagit%2Fp5-mst-13.2.git

Re: [PATCH] [perl #21875] Hash ref transformed as a list
Message-ID: <20030419190651.GD13333@fdgroup.com>

p4raw-id: //depot/perl@19276
---

diff --git a/t/comp/parser.t b/t/comp/parser.t
index 54ad351..b50d8af 100644
--- a/t/comp/parser.t
+++ b/t/comp/parser.t
@@ -9,7 +9,7 @@ BEGIN {
 }
 
 require "./test.pl";
-plan( tests => 21 );
+plan( tests => 37 );
 
 eval '%@x=0;';
 like( $@, qr/^Can't modify hash dereference in repeat \(x\)/, '%@x=0' );
@@ -97,3 +97,23 @@ print "#";
 print(
 $data{foo});
 pass();
+
+# Bug #21875
+# { q.* => ... } should be interpreted as hash, not block
+
+foreach my $line (split /\n/, <<'EOF')
+1 { foo => 'bar' }
+1 { qoo => 'bar' }
+1 { q   => 'bar' }
+1 { qq  => 'bar' }
+0 { q,'bar', }
+0 { q=bar= }
+0 { qq=bar= }
+1 { q=bar= => 'bar' }
+EOF
+{
+    my ($expect, $eval) = split / /, $line, 2;
+    my $result = eval $eval;
+    ok($@ eq  '', "eval $eval");
+    is(ref $result, $expect ? 'HASH' : '', $eval);
+}
diff --git a/toke.c b/toke.c
index 5c206b0..23ae908 100644
--- a/toke.c
+++ b/toke.c
@@ -3211,12 +3211,17 @@ Perl_yylex(pTHX)
 			    || ((*t == 'q' || *t == 'x') && ++t < PL_bufend
 				&& !isALNUM(*t))))
 		    {
+			/* skip q//-like construct */
 			char *tmps;
 			char open, close, term;
 			I32 brackets = 1;
 
 			while (t < PL_bufend && isSPACE(*t))
 			    t++;
+			/* check for q => */
+			if (t+1 < PL_bufend && t[0] == '=' && t[1] == '>') {
+			    OPERATOR(HASHBRACK);
+			}
 			term = *t;
 			open = term;
 			if (term && (tmps = strchr("([{< )]}> )]}>",term)))
@@ -3229,7 +3234,7 @@ Perl_yylex(pTHX)
 				else if (*t == open)
 				    break;
 			    }
-			else
+			else {
 			    for (t++; t < PL_bufend; t++) {
 				if (*t == '\\' && t+1 < PL_bufend)
 				    t++;
@@ -3238,8 +3243,13 @@ Perl_yylex(pTHX)
 				else if (*t == open)
 				    brackets++;
 			    }
+			}
+			t++;
 		    }
-		    t++;
+		    else
+			/* skip plain q word */
+			while (t < PL_bufend && isALNUM_lazy_if(t,UTF))
+			     t += UTF8SKIP(t);
 		}
 		else if (isALNUM_lazy_if(t,UTF)) {
 		    t += UTF8SKIP(t);