This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: [perl #50496] Bug Report: 'keys %+' does not return the correct keys.
authorAbigail <abigail@abigail.be>
Thu, 7 Feb 2008 17:53:30 +0000 (18:53 +0100)
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>
Thu, 14 Feb 2008 17:01:41 +0000 (17:01 +0000)
Message-ID: <20080207165330.GA25617@abigail.be>

with tweaks (one more test marked TODO)

p4raw-id: //depot/perl@33313

t/op/pat.t

index d2bc85a..3c446e0 100755 (executable)
@@ -3761,6 +3761,46 @@ sub iseq($$;$) {
     ok(!$@,'lvalue $+{...} should not throw an exception');
 }
 {
+    #
+    # Almost the same as the block above, except that the capture is nested.
+    #
+    my $s = 'foo bar baz';
+    my (@k,@v,@fetch,$res);
+    my $count = 0;
+    my @names = qw($+{A} $+{B} $+{C} $+{D});
+    if ($s = ~/(?<D>(?<A>foo)\s+(?<B>bar)?\s+(?<C>baz))/) {
+       while (my ($k,$v) = each(%+)) {
+           $count++;
+       }
+       @k = sort keys(%+);
+       @v = sort values(%+);
+       $res = 1;
+       push @fetch,
+           [ "$+{A}", "$2" ],
+           [ "$+{B}", "$3" ],
+           [ "$+{C}", "$4" ],
+           [ "$+{D}", $1 ],
+       ;
+    }
+    foreach (0..3) {
+       if ($fetch[$_]) {
+           local $TODO = $_ == 3;
+           iseq($fetch[$_][0],$fetch[$_][1],$names[$_]);
+       } else {
+           ok(0, $names[$_]);
+       }
+    }
+    iseq($res,1,"$s~=/(?<D>(?<A>foo)\s+(?<B>bar)?\s+(?<C>baz))/");
+    iseq($count,4,"Got 4 keys in %+ via each # TODO bug 50496");
+    iseq(0+@k, 4, 'Got 4 keys in %+ via keys # TODO bug 50496');
+    iseq("@k","A B C D", "Got expected keys # TODO bug 50496");
+    iseq("@v","bar baz foo foo bar baz", "Got expected values # TODO bug = 50496");
+    eval'
+       print for $+{this_key_doesnt_exist};
+    ';
+    ok(!$@,'lvalue $+{...} should not throw an exception');
+}
+{
     my $s='foo bar baz';
     my @res;
     if ('1234'=~/(?<A>1)(?<B>2)(?<A>3)(?<B>4)/) {
@@ -4619,7 +4659,7 @@ iseq(0+$::test,$::TestCount,"Got the right number of tests!");
 
 # Don't forget to update this!
 BEGIN {
-    $::TestCount = 4019;
+    $::TestCount = 4029;
     print "1..$::TestCount\n";
 }