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 (file)
--- 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 (file)
--- 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);