Warning bit fixes to t/op/caller.t

[p5sagit/p5-mst-13.2.git] / t / op / pat.t

diff --git a/t/op/pat.t b/t/op/pat.t
index 367b0bb..856d3ac 100755 (executable)
--- a/t/op/pat.t
+++ b/t/op/pat.t
@@ -4381,6 +4381,80 @@ sub kt
         }
     }
 }
+{
+    local $Message = "BBC(Bleadperl Breaks CPAN) Today: String::Multibyte";
+    my $re  = qr/(?:[\x00-\xFF]{4})/;
+    my $hyp = "\0\0\0-";
+    my $esc = "\0\0\0\\";
+
+    my $str = "$esc$hyp$hyp$esc$esc";
+    my @a = ($str =~ /\G(?:\Q$esc$esc\E|\Q$esc$hyp\E|$re)/g);
+
+    iseq(0+@a,3);
+    iseq(join('=', @a),"$esc$hyp=$hyp=$esc$esc");
+}
+# test for keys in %+ and %-
+{
+    my $_ = "abcdef";
+    /(?<foo>a)|(?<foo>b)/;
+    iseq( (join ",", sort keys %+), "foo" );
+    iseq( (join ",", sort keys %-), "foo" );
+    iseq( (join ",", sort values %+), "a" );
+    iseq( (join ",", sort map "@$_", values %-), "a " );
+    /(?<bar>a)(?<bar>b)(?<quux>.)/;
+    iseq( (join ",", sort keys %+), "bar,quux" );
+    iseq( (join ",", sort keys %-), "bar,quux" );
+    iseq( (join ",", sort values %+), "a,c" ); # leftmost
+    iseq( (join ",", sort map "@$_", values %-), "a b,c" );
+    /(?<un>a)(?<deux>c)?/; # second buffer won't capture
+    iseq( (join ",", sort keys %+), "un" );
+    iseq( (join ",", sort keys %-), "deux,un" );
+    iseq( (join ",", sort values %+), "a" );
+    iseq( (join ",", sort map "@$_", values %-), ",a" );
+}
+
+# length() on captures, the numbered ones end up in Perl_magic_len
+{
+    my $_ = "aoeu \xe6var ook";
+    /^ \w+ \s (?<eek>\S+)/x;
+
+    iseq( length($`), 0, 'length $`' );
+    iseq( length($'), 4, q[length $'] );
+    iseq( length($&), 9, 'length $&' );
+    iseq( length($1), 4, 'length $1' );
+    iseq( length($+{eek}), 4, 'length $+{eek} == length $1' );
+}
+
+{
+    my $ok=-1;
+
+    $ok=exists($-{x}) ? 1 : 0
+        if 'bar'=~/(?<x>foo)|bar/;
+    iseq($ok,1,'$-{x} exists after "bar"=~/(?<x>foo)|bar/');
+    iseq(scalar(%+), 0, 'scalar %+ == 0 after "bar"=~/(?<x>foo)|bar/');
+    iseq(scalar(%-), 1, 'scalar %- == 1 after "bar"=~/(?<x>foo)|bar/');
+
+    $ok=-1;
+    $ok=exists($+{x}) ? 1 : 0
+        if 'bar'=~/(?<x>foo)|bar/;
+    iseq($ok,0,'$+{x} not exists after "bar"=~/(?<x>foo)|bar/');
+    iseq(scalar(%+), 0, 'scalar %+ == 0 after "bar"=~/(?<x>foo)|bar/');
+    iseq(scalar(%-), 1, 'scalar %- == 1 after "bar"=~/(?<x>foo)|bar/');
+
+    $ok=-1;
+    $ok=exists($-{x}) ? 1 : 0
+        if 'foo'=~/(?<x>foo)|bar/;
+    iseq($ok,1,'$-{x} exists after "foo"=~/(?<x>foo)|bar/');
+    iseq(scalar(%+), 1, 'scalar %+ == 1 after "foo"=~/(?<x>foo)|bar/');
+    iseq(scalar(%-), 1, 'scalar %- == 1 after "foo"=~/(?<x>foo)|bar/');
+
+    $ok=-1;
+    $ok=exists($+{x}) ? 1 : 0
+        if 'foo'=~/(?<x>foo)|bar/;
+    iseq($ok,1,'$+{x} exists after "foo"=~/(?<x>foo)|bar/');
+}
+
+
 # Test counter is at bottom of file. Put new tests above here.
 #-------------------------------------------------------------------
 # Keep the following tests last -- they may crash perl
@@ -4426,44 +4500,10 @@ ok($@=~/\QSequence \k... not terminated in regex;\E/);
     iseq($_,"!Bang!1!Bang!2!Bang!3!Bang!");
 }
 
-# test for keys in %+ and %-
-{
-    my $_ = "abcdef";
-    /(?<foo>a)|(?<foo>b)/;
-    iseq( (join ",", sort keys %+), "foo" );
-    iseq( (join ",", sort keys %-), "foo" );
-    iseq( (join ",", sort values %+), "a" );
-    iseq( (join ",", sort map "@$_", values %-), "a " );
-    /(?<bar>a)(?<bar>b)(?<quux>.)/;
-    iseq( (join ",", sort keys %+), "bar,quux" );
-    iseq( (join ",", sort keys %-), "bar,quux" );
-    iseq( (join ",", sort values %+), "a,c" ); # leftmost
-    iseq( (join ",", sort map "@$_", values %-), "a b,c" );
-    /(?<un>a)(?<deux>c)?/; # second buffer won't capture
-    iseq( (join ",", sort keys %+), "un" );
-    iseq( (join ",", sort keys %-), "deux,un" );
-    iseq( (join ",", sort values %+), "a" );
-    iseq( (join ",", sort map "@$_", values %-), ",a" );
-}
-
-# length() on captures, these end up in Perl_magic_len
-{
-    my $_ = "aoeu \xe6var ook";
-    /^ \w+ \s (?<eek>\S+)/x;
-
-    iseq( length($`), 0, 'length $`' );
-    iseq( length($'), 4, q[length $'] );
-    iseq( length($&), 9, 'length $&' );
-    iseq( length($1), 4, 'length $1' );
-    iseq( length($+{eek}), 4, 'length $+{eek} == length $1' );
-}
-
 # Put new tests above the dotted line about a page above this comment
 iseq(0+$::test,$::TestCount,"Got the right number of tests!");
 # Don't forget to update this!
 BEGIN {
-    $::TestCount = 1948;
+    $::TestCount = 1960;
     print "1..$::TestCount\n";
 }
-
-