This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: [PATCH] length() on magic capture variables
[perl5.git] / t / op / pat.t
index 46900e8..5512b2b 100755 (executable)
@@ -4127,6 +4127,16 @@ for my $c ("z", "\0", "!", chr(254), chr(256)) {
         iseq($^R,'last regexp code result');
     }
     iseq($^R,'Nothing');
+
+    {
+        local $^R = "Bad";
+        ok('x foofoo y' =~ m{
+         (foo|bar)\1 # this time without the +
+        (?{"last regexp code result"})
+        }x);
+        iseq($^R,'last regexp code result');
+    }
+    iseq($^R,'Nothing');
 }
 {
     local $Message="RT#22395";
@@ -4316,6 +4326,26 @@ sub kt
         "Check that (?&..) to a buffer inside a (?|...) goes to the leftmost");
 }
 
+{
+    use warnings;
+    local $Message = "ASCII pattern that really is utf8";
+    my @w;
+    local $SIG{__WARN__}=sub{push @w,"@_"};
+    my $c=qq(\x{DF}); 
+    ok($c=~/${c}|\x{100}/);
+    ok(@w==0);
+}    
+{
+    local $Message = "corruption of match results of qr// across scopes";
+    my $qr=qr/(fo+)(ba+r)/;
+    'foobar'=~/$qr/;
+    iseq("$1$2","foobar");
+    {
+        'foooooobaaaaar'=~/$qr/;
+        iseq("$1$2",'foooooobaaaaar');    
+    }
+    iseq("$1$2","foobar");
+}    
 # Test counter is at bottom of file. Put new tests above here.
 #-------------------------------------------------------------------
 # Keep the following tests last -- they may crash perl
@@ -4361,11 +4391,43 @@ 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($`), 4, '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 = 1638;
+    $::TestCount = 1663;
     print "1..$::TestCount\n";
 }