This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Various .t's: Escape literal '}' and ']' in patterns
authorKarl Williamson <khw@cpan.org>
Tue, 10 Jan 2017 18:09:33 +0000 (11:09 -0700)
committerKarl Williamson <khw@cpan.org>
Fri, 13 Jan 2017 19:20:03 +0000 (12:20 -0700)
It is clearer to show that these characters which are sometimes meta and
sometimes literal are meant to be taken literally here.

15 files changed:
Porting/sync-with-cpan
ext/Devel-Peek/t/Peek.t
ext/POSIX/t/posix.t
lib/B/Deparse-core.t
lib/B/Deparse.pm
t/comp/parser.t
t/op/attrs.t
t/op/coreamp.t
t/op/taint.t
t/op/tr.t
t/re/anyof.t
t/re/pat_advanced.t
t/re/re_tests
t/uni/attrs.t
t/uni/gv.t

index 9c6a6b0..8245e5c 100755 (executable)
@@ -613,7 +613,7 @@ while (<$Maintainers_pl>) {
                 }
             }
 
-            if (/^    }/) {
+            if (/^    \}/) {
                 $in_mod_section = 0;
             }
         }
index d62e3b2..4775c1c 100644 (file)
@@ -77,7 +77,7 @@ sub do_test {
            # Could do this is in a s///mge but seems clearer like this:
            $pattern = join '', map {
                # If we identify the version condition, take *it* out whatever
-               s/\s*# (\$].*)$//
+               s/\s*# (\$\].*)$//
                    ? (eval $1 ? $_ : '')
                    : $_ # Didn't match, so this line is in
            } split /^/, $pattern;
index ea43bc0..7b456c1 100644 (file)
@@ -155,7 +155,7 @@ if ( $unix_mode ) {
     $pat = qr#[\\/]POSIX$#i;
 }
 else {
-    $pat = qr/\.POSIX]/i;
+    $pat = qr/\.POSIX\]/i;
 }
 like( getcwd(), qr/$pat/, 'getcwd' );
 
index 247869c..2ed797a 100644 (file)
@@ -107,7 +107,7 @@ sub testit {
     use feature [^\n]+
 (?:    (?:CORE::)?state sub \w+;
 )?    \Q$vars\E\(\) = (.*)
-}/s) {
+\}/s) {
            ::fail($desc);
            ::diag("couldn't extract line from boilerplate\n");
            ::diag($got_text);
index e14620b..3166415 100644 (file)
@@ -47,7 +47,7 @@ use B qw(class main_root main_start main_cv svref_2object opnumber perlstring
         MDEREF_SHIFT
     );
 
-$VERSION = '1.39';
+$VERSION = '1.40';
 use strict;
 use vars qw/$AUTOLOAD/;
 use warnings ();
@@ -558,7 +558,7 @@ sub next_todo {
                 #  makes use of a lexical var that's not in scope.
                 #  So strip it out.
                 return $pragmata
-                            if $use_dec =~ /^use \S+ \(@\{\$args\[0\];}\);/;
+                            if $use_dec =~ /^use \S+ \(@\{\$args\[0\];\}\);/;
 
                $use_dec =~ s/^(use|no)\b/$self->keyword($1)/e;
            }
index 901d66a..8be973b 100644 (file)
@@ -444,7 +444,7 @@ is prototype "Hello::_he_said", '_', 'initial tick in sub declaration';
        'literal -> after an array subscript within ""');
     @x = ['string'];
     # this used to give "string"
-    like("$x[0]-> [0]", qr/^ARRAY\([^)]*\)-> \[0]\z/,
+    like("$x[0]-> [0]", qr/^ARRAY\([^)]*\)-> \[0\]\z/,
        'literal -> [0] after an array subscript within ""');
 }
 
index 6f7d014..0d0fdd1 100644 (file)
@@ -52,7 +52,7 @@ like $@, qr/^Invalid SCALAR attribute: ["']?plugh["']? at/;
 eval '{my $x : plugh}';
 like $@, qr/^Invalid SCALAR attribute: ["']?plugh["']? at/;
 eval '{my ($x,$y) : plugh(})}';
-like $@, qr/^Invalid SCALAR attribute: ["']?plugh\(}\)["']? at/;
+like $@, qr/^Invalid SCALAR attribute: ["']?plugh\(\}\)["']? at/;
 
 # More syntax tests from the attributes manpage
 eval 'my $x : switch(10,foo(7,3))  :  expensive;';
index c958654..4b68569 100644 (file)
@@ -188,23 +188,23 @@ sub test_proto {
     my $more_args = $3 ? ',1' : '';
     eval " &CORE::$o(2$more_args) ";
     like $@, qr/^Type of arg 1 to &CORE::$o must be reference to one of(?x:
-                ) \[\Q$2\E] at /,
+                ) \[\Q$2\E\] at /,
         "&$o with non-ref arg";
     eval " &CORE::$o(*STDOUT{IO}$more_args) ";
     like $@, qr/^Type of arg 1 to &CORE::$o must be reference to one of(?x:
-                ) \[\Q$2\E] at /,
+                ) \[\Q$2\E\] at /,
         "&$o with ioref arg";
     my $class = ref *DATA{IO};
     eval " &CORE::$o(bless(*DATA{IO}, 'hov')$more_args) ";
     like $@, qr/^Type of arg 1 to &CORE::$o must be reference to one of(?x:
-                ) \[\Q$2\E] at /,
+                ) \[\Q$2\E\] at /,
         "&$o with ioref arg with hash overload (which does not count)";
     bless *DATA{IO}, $class;
     if (do {$2 !~ /&/}) {
       $tests++;
       eval " &CORE::$o(\\&scriggle$more_args) ";
       like $@, qr/^Type of arg 1 to &CORE::$o must be reference to one (?x:
-                  )of \[\Q$2\E] at /,
+                  )of \[\Q$2\E\] at /,
         "&$o with coderef arg";
     }    
   }
index 4d69498..c13eaf6 100644 (file)
@@ -152,7 +152,7 @@ my $TEST = 'TEST';
        while (my $v = $vars[0]) {
            local $ENV{$v} = $TAINT;
            last if eval { `$echo 1` };
-           last unless $@ =~ /^Insecure \$ENV\{$v}/;
+           last unless $@ =~ /^Insecure \$ENV\{$v\}/;
            shift @vars;
        }
        is("@vars", "");
@@ -163,7 +163,7 @@ my $TEST = 'TEST';
        is(eval { `$echo 1` }, "1\n");
        $ENV{TERM} = 'e=mc2' . $TAINT;
        is(eval { `$echo 1` }, undef);
-       like($@, qr/^Insecure \$ENV\{TERM}/);
+       like($@, qr/^Insecure \$ENV\{TERM\}/);
     }
 
     my $tmp;
@@ -184,7 +184,7 @@ my $TEST = 'TEST';
        is(eval { `$echo 1` }, undef);
        # Message can be different depending on whether echo
        # is a builtin or not
-       like($@, qr/^Insecure (?:directory in )?\$ENV\{PATH}/);
+       like($@, qr/^Insecure (?:directory in )?\$ENV\{PATH\}/);
     }
 
     # Relative paths in $ENV{PATH} are always implicitly tainted.
@@ -194,13 +194,13 @@ my $TEST = 'TEST';
 
         local $ENV{PATH} = '.';
         is(eval { `$echo 1` }, undef);
-        like($@, qr/^Insecure (?:directory in )?\$ENV\{PATH}/);
+        like($@, qr/^Insecure (?:directory in )?\$ENV\{PATH\}/);
 
         # Backslash should not fool perl into thinking that this is one
         # path.
         local $ENV{PATH} = '/\:.';
         is(eval { `$echo 1` }, undef);
-        like($@, qr/^Insecure (?:directory in )?\$ENV\{PATH}/);
+        like($@, qr/^Insecure (?:directory in )?\$ENV\{PATH\}/);
     }
 
     SKIP: {
@@ -208,14 +208,14 @@ my $TEST = 'TEST';
 
        $ENV{'DCL$PATH'} = $TAINT;
        is(eval { `$echo 1` }, undef);
-       like($@, qr/^Insecure \$ENV\{DCL\$PATH}/);
+       like($@, qr/^Insecure \$ENV\{DCL\$PATH\}/);
        SKIP: {
             skip q[can't find world-writeable directory to test DCL$PATH], 2
               unless $tmp;
 
            $ENV{'DCL$PATH'} = $tmp;
            is(eval { `$echo 1` }, undef);
-           like($@, qr/^Insecure directory in \$ENV\{DCL\$PATH}/);
+           like($@, qr/^Insecure directory in \$ENV\{DCL\$PATH\}/);
        }
        $ENV{'DCL$PATH'} = '';
     }
@@ -2246,7 +2246,7 @@ end
     ok("A" =~ /\p{$prop}/, "user-defined property: non-tainted case");
     $prop = "IsA$TAINT";
     eval { "A" =~ /\p{$prop}/};
-    like($@, qr/Insecure user-defined property \\p\{main::IsA}/,
+    like($@, qr/Insecure user-defined property \\p\{main::IsA\}/,
            "user-defined property: tainted case");
 }
 
index 2ef2a68..13d5e3c 100644 (file)
--- a/t/op/tr.t
+++ b/t/op/tr.t
@@ -34,12 +34,12 @@ is($_, "aBCDEFGHIJKLMNOPQRSTUVWXYz",    'partial uc');
 
 eval 'tr/a/\N{KATAKANA LETTER AINU P}/;';
 like $@,
-     qr/\\N\{KATAKANA LETTER AINU P} must not be a named sequence in transliteration operator/,
+     qr/\\N\{KATAKANA LETTER AINU P\} must not be a named sequence in transliteration operator/,
      "Illegal to tr/// named sequence";
 
 eval 'tr/\x{101}-\x{100}//;';
 like $@,
-     qr/Invalid range "\\x\{0101}-\\x\{0100}" in transliteration operator/,
+     qr/Invalid range "\\x\{0101\}-\\x\{0100\}" in transliteration operator/,
      "UTF-8 range with min > max";
 
 SKIP: {   # Test literal range end point special handling
index 978ec73..12ae043 100644 (file)
@@ -333,8 +333,8 @@ while (defined (my $test = shift @tests)) {
 
         # Convert platform-independent values to what is suitable for the
         # platform
-        $test =~ s/{INFINITY}/$highest_cp/g;
-        $test =~ s/{INFINITY_minus_1}/$next_highest_cp/g;
+        $test =~ s/\{INFINITY\}/$highest_cp/g;
+        $test =~ s/\{INFINITY_minus_1\}/$next_highest_cp/g;
 
         $test = "qr/$test/";
         my $actual_test = "use re qw(Debug COMPILE); $test";
index 08f4f53..5e5cc1f 100644 (file)
@@ -947,7 +947,7 @@ sub run_tests {
         ok "\N{LONG-STR}" =~ /^\N{LONG-STR}$/i, 'Verify under folding that long string works';
 
         eval '/(?[[\N{EMPTY-STR}]])/';
-        ok $@ && $@ =~ /Zero length \\N\{}/;
+        ok $@ && $@ =~ /Zero length \\N\{\}/;
 
         undef $w;
         {
index 2653b94..f210202 100644 (file)
@@ -1454,8 +1454,8 @@ foo(\h)bar        foo\tbar        y       $1      \t
 
 # Verify that \ escapes the { after \N, and causes \N to match non-newline
 abc\N\{U+BEEF} abc\n{UBEEF}    n               
-abc\N\{U+BEEF} abc.{UBEEF}     y       $&      abc.{UBEEF}
-[abc\N\{U+BEEF}]       -       c       -       \\N in a character class must be a named character
+abc\N\{U+BEEF\}        abc.{UBEEF}     y       $&      abc.{UBEEF}
+[abc\N\{U+BEEF\}]      -       c       -       \\N in a character class must be a named character
 
 # Verify that \N can be trailing and causes \N to match non-newline
 abc\N  abcd    y       $&      abcd
index 98f676e..81075a0 100644 (file)
@@ -37,7 +37,7 @@ like $@, qr/^Invalid SCALAR attribute: ["']?plǖgh["']? at/;
 eval '{my $x : plǖgh}';
 like $@, qr/^Invalid SCALAR attribute: ["']?plǖgh["']? at/;
 eval '{my ($x,$y) : plǖgh(})}';
-like $@, qr/^Invalid SCALAR attribute: ["']?plǖgh\(}\)["']? at/;
+like $@, qr/^Invalid SCALAR attribute: ["']?plǖgh\(\}\)["']? at/;
 
 # More syntax tests from the attributes manpage
 eval 'my $x : Şʨᚻ(10,ᕘ(7,3))  :  에ㄒ펜ሲ;';
index f518831..427831b 100644 (file)
@@ -125,8 +125,8 @@ is (scalar %ᕘ, 0);
     my $E_grave = utf8::unicode_to_native(0xc8);
     my $pat = sprintf(
         # It took a lot of experimentation to get the backslashes right (khw)
-        "Argument \"\\*main::(?:PW\\\\x\\{%x}MPF"
-                            . "|SKR\\\\x\\{%x}\\\\x\\{%x}\\\\x\\{%x})\" "
+        "Argument \"\\*main::(?:PW\\\\x\\{%x\\}MPF"
+                            . "|SKR\\\\x\\{%x\\}\\\\x\\{%x\\}\\\\x\\{%x\\})\" "
                             . "isn't numeric in sprintf",
                               $O_grave, $E_grave, $E_grave, $E_grave);
     $pat = qr/$pat/;