avoid 'unescaped left brace' warnings

[perl5.git] / t / re / pat_re_eval.t

diff --git a/t/re/pat_re_eval.t b/t/re/pat_re_eval.t
index f158f85..1d724c2 100644 (file)
--- a/t/re/pat_re_eval.t
+++ b/t/re/pat_re_eval.t
@@ -23,7 +23,7 @@ BEGIN {
 }
 
 
-plan tests => 448;  # Update this when adding/deleting tests.
+plan tests => 454;  # Update this when adding/deleting tests.
 
 run_tests() unless caller;
 
@@ -772,8 +772,8 @@ sub run_tests {
        norun("runtime code with unbalanced {} norun");
 
        use re 'eval';
-       ok("a{" =~ '^(??{"a{"})$', "non-pattern literal code");
-       ok("a{" =~ /^${\'(??{"a{"})'}$/, "runtime code with unbalanced {}");
+       ok("a{" =~ '^a(??{"{"})$', "non-pattern literal code");
+       ok("a{" =~ /^a${\'(??{"{"})'}$/, "runtime code with unbalanced {}");
     }
 
     # make sure warnings come from the right place
@@ -966,6 +966,25 @@ sub run_tests {
        like($warn, qr/value \$u1 in pattern match.*\n.*value at/, 'uninit');
     }
 
+    # test that code blocks are called in scalar context
+
+    {
+       my @a = (0);
+       ok("" =~ /^(?{@a})$/, '(?{}) in scalar context');
+       is($^R, 1, '(?{}) in scalar context: $^R');
+       ok("1" =~ /^(??{@a})$/, '(??{}) in scalar context');
+       ok("foo" =~ /^(?(?{@a})foo|bar)$/, '(?(?{})|) in scalar context');
+    }
+
+    # BEGIN in compiled blocks shouldn't mess with $1 et al
+
+    {
+       use re 'eval';
+       my $code1 = '(B)(??{ BEGIN { "X" =~ /X/ } $1})(C)';
+       ok("ABBCA" =~ /^(.)(??{$code1})\1$/, '(?{}) BEGIN and $1');
+       my $code2 = '(B)(??{ BEGIN { "X" =~ /X/ } $1 =~ /(.)/ ? $1 : ""})(C)';
+       ok("ABBCA" =~ /^(.)(??{$code2})\1$/, '(?{}) BEGIN and $1 mark 2');
+    }
 
 
 } # End of sub run_tests