This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
PATCH: [perl #119101] Extraneous warnings in Parse::ErrorString::Perl
authorKarl Williamson <public@khwilliamson.com>
Wed, 31 Jul 2013 21:05:43 +0000 (15:05 -0600)
committerKarl Williamson <public@khwilliamson.com>
Wed, 31 Jul 2013 23:21:53 +0000 (17:21 -0600)
(Since 5.18.0)

This is from https://rt.cpan.org/Ticket/Display.html?id=87458.

Working on this ticket caused me to be more certain of the advisability
of the deprecation message that was added in v5.18.0, and which was
inappropriately being raised in the test suite for this module.

The message notes that escaping the metacharacter '{', '[', or '(')
doesn't actually do anything in a pattern whose delimiters are {} [] or
() respectively.

The code in question looked something like

    my $pat = "m{\Q$foo}";
    ...
    eval "$bar =~ $pat";

where $foo comes from somewhere else and contained something like
\x{61}.  The message should not be raised because the \Q changes that to
\\x\{61\}, and so the \x loses its special meaning as well, and the left
brace is not a metacharacter in this context.  The solution is to look
at all the backslashes before the 'x' and only raise the message if
there are an odd number of them.

But, if $foo had been something like "bar{3}", the \Q would have
transformed that into "bar\{3\}.  In the code above, this matches
"b" followed by "a" followed by 3 "r"s.

Similarly for [] and ().

    my $foo = "(abc)";
    my $pat = "m(\Q$foo)";
    ...
    eval "$bar =~ $pat";

will not match the parens in $foo literally, but treat them as marking a
group.

The bottom line is that currently you cannot rely on \Q to properly
quote in a regex pattern in which the delimiters are mirrored
metacharacters.  The only current safe mirrored delimiters are <>, which
are not metacharacters.  Starting in 5.18.0, there is a default-on
message that catches this.  Starting with this commit, certain false
positives have been removed, and I know of none other.

t/lib/warnings/toke
toke.c

index 3faa256..a7ee8de 100644 (file)
@@ -1381,22 +1381,34 @@ sub { # do not actually call require
 EXPECT
 ########
 # toke.c
-# [perl #113094]
+# [perl #113094], [perl #119101]
 print "aa" =~ m{^a\{1,2\}$}, "\n";
 print "aa" =~ m{^a\x\{61\}$}, "\n";
+print "a\\x{6F}" =~ m{^a\\x\{6F\}$}, "\n";
+print "a\\o" =~ m{^a\\\x\{6F\}$}, "\n";
+print "a\\\\x{6F}" =~ m{^a\\\\x\{6F\}$}, "\n";
+print "a\\\\o"     =~ m{^a\\\\\x\{6F\}$}, "\n";
 print "aa" =~ m{^a{1,2}$}, "\n";
 print "aq" =~ m[^a\[a-z\]$], "\n";
 print "aq" =~ m(^a\(q\)$), "\n";
 no warnings 'deprecated';
 print "aa" =~ m{^a\{1,2\}$}, "\n";
 print "aa" =~ m{^a\x\{61\}$}, "\n";
+print "a\\x{6F}" =~ m{^a\\x\{6F\}$}, "\n";
+print "a\\o" =~ m{^a\\\x\{6f\}$}, "\n";
 print "aq" =~ m[^a\[a-z\]$], "\n";
 print "aq" =~ m(^a\(q\)$), "\n";
 EXPECT
 Useless use of '\'; doesn't escape metacharacter '{' at - line 3.
 Useless use of '\'; doesn't escape metacharacter '{' at - line 4.
-Useless use of '\'; doesn't escape metacharacter '[' at - line 6.
-Useless use of '\'; doesn't escape metacharacter '(' at - line 7.
+Useless use of '\'; doesn't escape metacharacter '{' at - line 6.
+Useless use of '\'; doesn't escape metacharacter '{' at - line 8.
+Useless use of '\'; doesn't escape metacharacter '[' at - line 10.
+Useless use of '\'; doesn't escape metacharacter '(' at - line 11.
+1
+1
+1
+1
 1
 1
 1
@@ -1405,4 +1417,6 @@ q
 1
 1
 1
+1
+1
 q
diff --git a/toke.c b/toke.c
index 578fe14..13265e1 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -10710,26 +10710,39 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims, int re_reparse,
                          * context where the delimiter is also a metacharacter,
                          * the backslash is useless, and deprecated.  () and []
                          * are meta in any context. {} are meta only when
-                         * appearing in a quantifier or in things like '\p{'.
-                         * They also aren't meta unless there is a matching
-                         * closed, escaped char later on within the string.
-                         * If 's' points to an open, set a flag; if to a close,
-                         * test that flag, and raise a warning if it was set */
+                         * appearing in a quantifier or in things like '\p{'
+                         * (but '\\p{' isn't meta).  They also aren't meta
+                         * unless there is a matching closed, escaped char
+                         * later on within the string.  If 's' points to an
+                         * open, set a flag; if to a close, test that flag, and
+                         * raise a warning if it was set */
 
                        if (deprecate_escaped_meta) {
                             if (*s == PL_multi_open) {
                                 if (*s != '{') {
                                     escaped_open = s;
                                 }
-                                else if (regcurly(s,
-                                                  TRUE /* Look for a closing
-                                                          '\}' */)
-                                         || (s - start > 2  /* Look for e.g.
-                                                               '\x{' */
-                                             && _generic_isCC(*(s-2), _CC_BACKSLASH_FOO_LBRACE_IS_META)))
-                                {
+                                     /* Look for a closing '\}' */
+                                else if (regcurly(s, TRUE)) {
                                     escaped_open = s;
                                 }
+                                     /* Look for e.g.  '\x{' */
+                                else if (s - start > 2
+                                         && _generic_isCC(*(s-2),
+                                             _CC_BACKSLASH_FOO_LBRACE_IS_META))
+                                { /* Exclude '\\x', '\\\\x', etc. */
+                                    char *lookbehind = s - 4;
+                                    bool is_meta = TRUE;
+                                    while (lookbehind >= start
+                                           && *lookbehind == '\\')
+                                    {
+                                        is_meta = ! is_meta;
+                                        lookbehind--;
+                                    }
+                                    if (is_meta) {
+                                        escaped_open = s;
+                                    }
+                                }
                             }
                             else if (escaped_open) {
                                 Perl_warner(aTHX_ packWARN(WARN_DEPRECATED),