Re: [perl #50496] Bug Report: 'keys %+' does not return the correct keys.

Message-ID: <20080207165330.GA25617@abigail.be>

with tweaks (one more test marked TODO)

p4raw-id: //depot/perl@33313

1 files changed, 41 insertions, 1 deletions

diff --git a/t/op/pat.t b/t/op/pat.t
index d2bc85a8aa..3c446e0d51 100755
--- a/t/op/pat.t
+++ b/t/op/pat.t
@@ -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";
 }