Eval fails in certain situations (eval "{'...")

On Sun, 20 Jul 1997 16:02:05 MDT, Dave Carrigan wrote:
>Eval will fail in the following situation:
>
>- eval'ing a string
>- the string represents an anonymous hash
>- the first key of the anon hash is single quoted, and contains an
>  embedded single quote escaped with a backslash
>- using the form `` $ref = eval $string ''
>
>The MLDBM module uses this form of eval all the time, so the above
>situation actually has the potential to occur quite often.

>$string2 = "{'a\\'' => 'foo', 'b' => 'bar', 'c' => 'bat'}";

That is one of the cases where the note in perlref (about
disambiguating braces not preceded by anything else) applies.

However, in this particular case, the code that recognizes if
a literal string is the first thing inside the curlies is not
doing a thorough job of it.  The attached patch should cure
it.

Note that you'll still need to write C<eval "{ $a => 'foo' }">
as C<eval "+{ $a => 'foo' }"> if you want it to evaluate as a
hashref.  Perl only auto-disambiguates if the first thing in
the curlies is a literal string followed by a comma or =>.

I'll change MLDBM to conform, for the next release.

p5p-msgid: 199707211753.NAA14940@aatma.engin.umich.edu

diff --git a/t/comp/term.t b/t/comp/term.t
index b248e9b..eb99680 100755 (executable)
--- a/t/comp/term.t
+++ b/t/comp/term.t
@@ -4,7 +4,7 @@
 
 # tests that aren't important enough for base.term
 
-print "1..14\n";
+print "1..22\n";
 
 $x = "\\n";
 print "#1\t:$x: eq " . ':\n:' . "\n";
@@ -33,3 +33,38 @@ if ("$foo[1]b" eq "2b") { print "ok 12\n";} else {print "not ok 12\n";}
 if ("@foo[0..1]b" eq "1 2b") { print "ok 13\n";} else {print "not ok 13\n";}
 $" = '::';
 if ("@foo[0..1]b" eq "1::2b") { print "ok 14\n";} else {print "not ok 14\n";}
+
+# test if C<eval "{...}"> distinguishes between blocks and hashrefs
+
+$a = "{ '\\'' , 'foo' }";
+$a = eval $a;
+if (ref($a) eq 'HASH') {print "ok 15\n";} else {print "not ok 15\n";}
+
+$a = "{ '\\\\\\'abc' => 'foo' }";
+$a = eval $a;
+if (ref($a) eq 'HASH') {print "ok 16\n";} else {print "not ok 16\n";}
+
+$a = "{'a\\\n\\'b','foo'}";
+$a = eval $a;
+if (ref($a) eq 'HASH') {print "ok 17\n";} else {print "not ok 17\n";}
+
+$a = "{'\\\\\\'\\\\'=>'foo'}";
+$a = eval $a;
+if (ref($a) eq 'HASH') {print "ok 18\n";} else {print "not ok 18\n";}
+
+$a = "{q,a'b,,'foo'}";
+$a = eval $a;
+if (ref($a) eq 'HASH') {print "ok 19\n";} else {print "not ok 19\n";}
+
+$a = "{q[[']]=>'foo'}";
+$a = eval $a;
+if (ref($a) eq 'HASH') {print "ok 20\n";} else {print "not ok 20\n";}
+
+# needs disambiguation if first term is a variable
+$a = "+{ \$a , 'foo'}";
+$a = eval $a;
+if (ref($a) eq 'HASH') {print "ok 21\n";} else {print "not ok 21\n";}
+
+$a = "+{ \$a=>'foo'}";
+$a = eval $a;
+if (ref($a) eq 'HASH') {print "ok 22\n";} else {print "not ok 22\n";}

diff --git a/toke.c b/toke.c
index b443bb2..02b54e0 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -1990,19 +1990,73 @@ yylex()
                s = skipspace(s);
                if (*s == '}')
                    OPERATOR(HASHBRACK);
-               if (isALPHA(*s)) {
-                   for (t = s; t < bufend && isALNUM(*t); t++) ;
+               /* This hack serves to disambiguate a pair of curlies
+                * as being a block or an anon hash.  Normally, expectation
+                * determines that, but in cases where we're not in a
+                * position to expect anything in particular (like inside
+                * eval"") we have to resolve the ambiguity.  This code
+                * covers the case where the first term in the curlies is a
+                * quoted string.  Most other cases need to be explicitly
+                * disambiguated by prepending a `+' before the opening
+                * curly in order to force resolution as an anon hash.
+                *
+                * XXX should probably propagate the outer expectation
+                * into eval"" to rely less on this hack, but that could
+                * potentially break current behavior of eval"".
+                * GSAR 97-07-21
+                */
+               t = s;
+               if (*s == '\'' || *s == '"' || *s == '`') {
+                   /* common case: get past first string, handling escapes */
+                   for (t++; t < bufend && *t != *s;)
+                       if (*t++ == '\\' && (*t == '\\' || *t == *s))
+                           t++;
+                   t++;
+               }
+               else if (*s == 'q') {
+                   if (++t < bufend
+                       && (!isALNUM(*t)
+                           || ((*t == 'q' || *t == 'x') && ++t < bufend
+                               && !isALNUM(*t)))) {
+                       char *tmps;
+                       char open, close, term;
+                       I32 brackets = 1;
+
+                       while (t < bufend && isSPACE(*t))
+                           t++;
+                       term = *t;
+                       open = term;
+                       if (term && (tmps = strchr("([{< )]}> )]}>",term)))
+                           term = tmps[5];
+                       close = term;
+                       if (open == close)
+                           for (t++; t < bufend; t++) {
+                               if (*t == '\\' && t+1 < bufend && term != '\\')
+                                   t++;
+                               else if (*t == term)
+                                   break;
+                           }
+                       else
+                           for (t++; t < bufend; t++) {
+                               if (*t == '\\' && t+1 < bufend && term != '\\')
+                                   t++;
+                               else if (*t == term && --brackets <= 0)
+                                   break;
+                               else if (*t == open)
+                                   brackets++;
+                           }
+                   }
+                   t++;
                }
-               else if (*s == '\'' || *s == '"') {
-                   t = strchr(s+1,*s);
-                   if (!t++)
-                       t = s;
+               else if (isALPHA(*s)) {
+                   for (t++; t < bufend && isALNUM(*t); t++) ;
                }
-               else
-                   t = s;
                while (t < bufend && isSPACE(*t))
                    t++;
-               if ((*t == ',' && !isLOWER(*s)) || (*t == '=' && t[1] == '>'))
+               /* if comma follows first term, call it an anon hash */
+               /* XXX it could be a comma expression with loop modifiers */
+               if (t < bufend && ((*t == ',' && (*s == 'q' || !isLOWER(*s)))
+                                  || (*t == '=' && t[1] == '>')))
                    OPERATOR(HASHBRACK);
                if (expect == XREF)
                    expect = XTERM;