Various .t's: Escape literal '}' and ']' in patterns

It is clearer to show that these characters which are sometimes meta and
sometimes literal are meant to be taken literally here.

diff --git a/Porting/sync-with-cpan b/Porting/sync-with-cpan
index 9c6a6b0..8245e5c 100755 (executable)
--- a/Porting/sync-with-cpan
+++ b/Porting/sync-with-cpan
@@ -613,7 +613,7 @@ while (<$Maintainers_pl>) {
                 }
             }
 
                 }
             }
 

-            if (/^    }/) {
+            if (/^    \}/) {

                 $in_mod_section = 0;
             }
         }
                 $in_mod_section = 0;
             }
         }

diff --git a/ext/Devel-Peek/t/Peek.t b/ext/Devel-Peek/t/Peek.t
index d62e3b2..4775c1c 100644 (file)
--- a/ext/Devel-Peek/t/Peek.t
+++ b/ext/Devel-Peek/t/Peek.t
@@ -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
            # 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;
                    ? (eval $1 ? $_ : '')
                    : $_ # Didn't match, so this line is in
            } split /^/, $pattern;

diff --git a/ext/POSIX/t/posix.t b/ext/POSIX/t/posix.t
index ea43bc0..7b456c1 100644 (file)
--- a/ext/POSIX/t/posix.t
+++ b/ext/POSIX/t/posix.t
@@ -155,7 +155,7 @@ if ( $unix_mode ) {
     $pat = qr#[\\/]POSIX$#i;
 }
 else {
     $pat = qr#[\\/]POSIX$#i;
 }
 else {

-    $pat = qr/\.POSIX]/i;
+    $pat = qr/\.POSIX\]/i;

 }
 like( getcwd(), qr/$pat/, 'getcwd' );
 
 }
 like( getcwd(), qr/$pat/, 'getcwd' );
 

diff --git a/lib/B/Deparse-core.t b/lib/B/Deparse-core.t
index 247869c..2ed797a 100644 (file)
--- a/lib/B/Deparse-core.t
+++ b/lib/B/Deparse-core.t
@@ -107,7 +107,7 @@ sub testit {
     use feature [^\n]+
 (?:    (?:CORE::)?state sub \w+;
 )?    \Q$vars\E\(\) = (.*)
     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);
            ::fail($desc);
            ::diag("couldn't extract line from boilerplate\n");
            ::diag($got_text);

diff --git a/lib/B/Deparse.pm b/lib/B/Deparse.pm
index e14620b..3166415 100644 (file)
--- a/lib/B/Deparse.pm
+++ b/lib/B/Deparse.pm
@@ -47,7 +47,7 @@ use B qw(class main_root main_start main_cv svref_2object opnumber perlstring
         MDEREF_SHIFT
     );
 
         MDEREF_SHIFT
     );
 

-$VERSION = '1.39';
+$VERSION = '1.40';

 use strict;
 use vars qw/$AUTOLOAD/;
 use warnings ();
 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
                 #  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;
            }
 
                $use_dec =~ s/^(use|no)\b/$self->keyword($1)/e;
            }

diff --git a/t/comp/parser.t b/t/comp/parser.t
index 901d66a..8be973b 100644 (file)
--- a/t/comp/parser.t
+++ b/t/comp/parser.t
@@ -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"
        '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 ""');
 }
 
        'literal -> [0] after an array subscript within ""');
 }
 

diff --git a/t/op/attrs.t b/t/op/attrs.t
index 6f7d014..0d0fdd1 100644 (file)
--- a/t/op/attrs.t
+++ b/t/op/attrs.t
@@ -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(})}';
 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;';
 
 # More syntax tests from the attributes manpage
 eval 'my $x : switch(10,foo(7,3))  :  expensive;';

diff --git a/t/op/coreamp.t b/t/op/coreamp.t
index c958654..4b68569 100644 (file)
--- a/t/op/coreamp.t
+++ b/t/op/coreamp.t
@@ -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:
     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:
         "&$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:
         "&$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:
         "&$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";
     }    
   }
         "&$o with coderef arg";
     }    
   }

diff --git a/t/op/taint.t b/t/op/taint.t
index 4d69498..c13eaf6 100644 (file)
--- a/t/op/taint.t
+++ b/t/op/taint.t
@@ -152,7 +152,7 @@ my $TEST = 'TEST';
        while (my $v = $vars[0]) {
            local $ENV{$v} = $TAINT;
            last if eval { `$echo 1` };
        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", "");
            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);
        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;
     }
 
     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
        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.
     }
 
     # Relative paths in $ENV{PATH} are always implicitly tainted.


@@ -194,13 +194,13 @@ my $TEST = 'TEST';
 
         local $ENV{PATH} = '.';
         is(eval { `$echo 1` }, undef);
 
         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);
 
         # 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: {
     }
 
     SKIP: {


@@ -208,14 +208,14 @@ my $TEST = 'TEST';
 
        $ENV{'DCL$PATH'} = $TAINT;
        is(eval { `$echo 1` }, undef);
 
        $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);
        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'} = '';
     }
        }
        $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}/};
     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");
 }
 
            "user-defined property: tainted case");
 }
 

diff --git a/t/op/tr.t b/t/op/tr.t
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 $@,
 
 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 $@,
      "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
      "UTF-8 range with min > max";
 
 SKIP: {   # Test literal range end point special handling

diff --git a/t/re/anyof.t b/t/re/anyof.t
index 978ec73..12ae043 100644 (file)
--- a/t/re/anyof.t
+++ b/t/re/anyof.t
@@ -333,8 +333,8 @@ while (defined (my $test = shift @tests)) {
 
         # Convert platform-independent values to what is suitable for the
         # platform
 
         # 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";
 
         $test = "qr/$test/";
         my $actual_test = "use re qw(Debug COMPILE); $test";

diff --git a/t/re/pat_advanced.t b/t/re/pat_advanced.t
index 08f4f53..5e5cc1f 100644 (file)
--- a/t/re/pat_advanced.t
+++ b/t/re/pat_advanced.t
@@ -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 "\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;
         {
 
         undef $w;
         {

diff --git a/t/re/re_tests b/t/re/re_tests
index 2653b94..f210202 100644 (file)
--- a/t/re/re_tests
+++ b/t/re/re_tests
@@ -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               
 
 # 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
 
 # Verify that \N can be trailing and causes \N to match non-newline
 abc\N  abcd    y       $&      abcd

diff --git a/t/uni/attrs.t b/t/uni/attrs.t
index 98f676e..81075a0 100644 (file)
--- a/t/uni/attrs.t
+++ b/t/uni/attrs.t
@@ -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(})}';
 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))  :  에ㄒ펜ሲ;';
 
 # More syntax tests from the attributes manpage
 eval 'my $x : Şʨᚻ(10,ᕘ(7,3))  :  에ㄒ펜ሲ;';

diff --git a/t/uni/gv.t b/t/uni/gv.t
index f518831..427831b 100644 (file)
--- a/t/uni/gv.t
+++ b/t/uni/gv.t
@@ -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)
     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/;
                             . "isn't numeric in sprintf",
                               $O_grave, $E_grave, $E_grave, $E_grave);
     $pat = qr/$pat/;