Resubmit change #28095

p4raw-link: @28095 on //depot/perl: a86fbd4f9d493275993c0370a0246611dbcffc30

p4raw-id: //depot/perl@28097

1 files changed, 158 insertions, 118 deletions

diff --git a/t/op/grep.t b/t/op/grep.t
index 3e5d7168a0..d7fe515a4b 100755
--- a/t/op/grep.t
+++ b/t/op/grep.t
@@ -4,166 +4,206 @@
 # grep() and map() tests
 #
 
-print "1..38\n";
-
-$test = 1;
-
-sub ok {
-    my ($got,$expect) = @_;
-    print "# expected [$expect], got [$got]\nnot " if $got ne $expect;
-    print "ok $test\n";
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = qw(. ../lib);
 }
 
+require "test.pl";
+plan( tests => 60 );
+
 {
-   my @lol = ([qw(a b c)], [], [qw(1 2 3)]);
-   my @mapped = map  {scalar @$_} @lol;
-   ok "@mapped", "3 0 3";
-   $test++;
-
-   my @grepped = grep {scalar @$_} @lol;
-   ok "@grepped", "$lol[0] $lol[2]";
-   $test++;
-
-   @grepped = grep { $_ } @mapped;
-   ok "@grepped", "3 3";
-   $test++;
+    my @lol = ([qw(a b c)], [], [qw(1 2 3)]);
+    my @mapped = map  {scalar @$_} @lol;
+    cmp_ok("@mapped", 'eq', "3 0 3", 'map scalar list of list');
+
+    my @grepped = grep {scalar @$_} @lol;
+    cmp_ok("@grepped", 'eq', "$lol[0] $lol[2]", 'grep scalar list of list');
+    $test++;
+
+    @grepped = grep { $_ } @mapped;
+    cmp_ok( "@grepped", 'eq',  "3 3", 'grep basic');
 }
 
 {
-   print map({$_} ("ok $test\n"));
-   $test++;
-   print map
-            ({$_} ("ok $test\n"));
-   $test++;
-   print((map({a => $_}, ("ok $test\n")))[0]->{a});
-   $test++;
-   print((map
-            ({a=>$_},
-	     ("ok $test\n")))[0]->{a});
-   $test++;
-   print map { $_ } ("ok $test\n");
-   $test++;
-   print map
-            { $_ } ("ok $test\n");
-   $test++;
-   print((map {a => $_}, ("ok $test\n"))[0]->{a});
-   $test++;
-   print((map
-            {a=>$_},
-	     ("ok $test\n"))[0]->{a});
-   $test++;
-   my $x = "ok \xFF\xFF\n";
-   print map($_&$x,("ok $test\n"));
-   $test++;
-   print map
-            ($_ & $x, ("ok $test\n"));
-   $test++;
-   print map { $_ & $x } ("ok $test\n");
-   $test++;
-   print map
-             { $_&$x } ("ok $test\n");
-   $test++;
-
-   print grep({$_} ("ok $test\n"));
-   $test++;
-   print grep
-            ({$_} ("ok $test\n"));
-   $test++;
-   print grep({a => $_}->{a}, ("ok $test\n"));
-   $test++;
-   print grep
-	     ({a => $_}->{a},
-	     ("ok $test\n"));
-   $test++;
-   print grep { $_ } ("ok $test\n");
-   $test++;
-   print grep
-             { $_ } ("ok $test\n");
-   $test++;
-   print grep {a => $_}->{a}, ("ok $test\n");
-   $test++;
-   print grep
-	     {a => $_}->{a},
-	     ("ok $test\n");
-   $test++;
-   print grep($_&"X",("ok $test\n"));
-   $test++;
-   print grep
-            ($_&"X", ("ok $test\n"));
-   $test++;
-   print grep { $_ & "X" } ("ok $test\n");
-   $test++;
-   print grep
-             { $_ & "X" } ("ok $test\n");
-   $test++;
+    my @res;
+
+    @res = map({$_} ("geronimo"));
+    cmp_ok( scalar(@res), '==', 1, 'basic map nr');
+    cmp_ok( $res[0], 'eq', 'geronimo', 'basic map is');
+
+    @res = map
+             ({$_} ("yoyodyne"));
+    cmp_ok( scalar(@res), '==', 1, 'linefeed map nr');
+    cmp_ok( $res[0], 'eq', 'yoyodyne', 'linefeed map is');
+
+    @res = (map(
+       {a =>$_},
+     ("chobb")))[0]->{a};
+    cmp_ok( scalar(@res), '==', 1, 'deref map nr');
+    cmp_ok( $res[0], 'eq', 'chobb', 'deref map is');
+
+    @res = map {$_} ("geronimo");
+    cmp_ok( scalar(@res), '==', 1, 'no paren basic map nr');
+    cmp_ok( $res[0], 'eq', 'geronimo', 'no paren basic map is');
+
+    @res = map
+             {$_} ("yoyodyne");
+    cmp_ok( scalar(@res), '==', 1, 'no paren linefeed map nr');
+    cmp_ok( $res[0], 'eq', 'yoyodyne', 'no paren linefeed map is');
+
+    @res = (map
+           {a =>$_},
+       ("chobb"))[0]->{a};
+    cmp_ok( scalar(@res), '==', 1, 'no paren deref map nr');
+    cmp_ok( $res[0], 'eq', 'chobb', 'no paren deref map is');
+
+    my $x = "\xFF\xFF\xFF\xFF\xFF\xFF\xFF\n";
+
+    @res = map($_&$x,("sferics\n"));
+    cmp_ok( scalar(@res), '==', 1, 'binand map nr 1');
+    cmp_ok( $res[0], 'eq', "sferics\n", 'binand map is 1');
+
+    @res = map
+            ($_ & $x, ("sferics\n"));
+    cmp_ok( scalar(@res), '==', 1, 'binand map nr 2');
+    cmp_ok( $res[0], 'eq', "sferics\n", 'binand map is 2');
+
+    @res = map { $_ & $x } ("sferics\n");
+    cmp_ok( scalar(@res), '==', 1, 'binand map nr 3');
+    cmp_ok( $res[0], 'eq', "sferics\n", 'binand map is 3');
+
+    @res = map
+             { $_&$x } ("sferics\n");
+    cmp_ok( scalar(@res), '==', 1, 'binand map nr 4');
+    cmp_ok( $res[0], 'eq', "sferics\n", 'binand map is 4');
+
+    @res = grep({$_} ("geronimo"));
+    cmp_ok( scalar(@res), '==', 1, 'basic grep nr');
+    cmp_ok( $res[0], 'eq', 'geronimo', 'basic grep is');
+
+    @res = grep
+                ({$_} ("yoyodyne"));
+    cmp_ok( scalar(@res), '==', 1, 'linefeed grep nr');
+    cmp_ok( $res[0], 'eq', 'yoyodyne', 'linefeed grep is');
+
+    @res = grep
+        ({a=>$_}->{a},
+        ("chobb"));
+    cmp_ok( scalar(@res), '==', 1, 'deref grep nr');
+    cmp_ok( $res[0], 'eq', 'chobb', 'deref grep is');
+
+    @res = grep {$_} ("geronimo");
+    cmp_ok( scalar(@res), '==', 1, 'no paren basic grep nr');
+    cmp_ok( $res[0], 'eq', 'geronimo', 'no paren basic grep is');
+
+    @res = grep
+                {$_} ("yoyodyne");
+    cmp_ok( scalar(@res), '==', 1, 'no paren linefeed grep nr');
+    cmp_ok( $res[0], 'eq', 'yoyodyne', 'no paren linefeed grep is');
+
+    @res = grep {a=>$_}->{a}, ("chobb");
+    cmp_ok( scalar(@res), '==', 1, 'no paren deref grep nr');
+    cmp_ok( $res[0], 'eq', 'chobb', 'no paren deref grep is');
+
+    @res = grep
+         {a=>$_}->{a}, ("chobb");
+    cmp_ok( scalar(@res), '==', 1, 'no paren deref linefeed  nr');
+    cmp_ok( $res[0], 'eq', 'chobb', 'no paren deref linefeed  is');
+
+    @res = grep($_&"X", ("bodine"));
+    cmp_ok( scalar(@res), '==', 1, 'binand X grep nr');
+    cmp_ok( $res[0], 'eq', 'bodine', 'binand X grep is');
+
+    @res = grep
+           ($_&"X", ("bodine"));
+    cmp_ok( scalar(@res), '==', 1, 'binand X linefeed grep nr');
+    cmp_ok( $res[0], 'eq', 'bodine', 'binand X linefeed grep is');
+
+    @res = grep {$_&"X"} ("bodine");
+    cmp_ok( scalar(@res), '==', 1, 'no paren binand X grep nr');
+    cmp_ok( $res[0], 'eq', 'bodine', 'no paren binand X grep is');
+
+    @res = grep
+           {$_&"X"} ("bodine");
+    cmp_ok( scalar(@res), '==', 1, 'no paren binand X linefeed grep nr');
+    cmp_ok( $res[0], 'eq', 'bodine', 'no paren binand X linefeed grep is');
 }
 
-# Tests for "for" in "map" and "grep"
-# Used to dump core, bug [perl #17771]
-
 {
+    # Tests for "for" in "map" and "grep"
+    # Used to dump core, bug [perl #17771]
+
     my @x;
     my $y = '';
     @x = map { $y .= $_ for 1..2; 1 } 3..4;
-    print "# @x,$y\n";
-    print "@x,$y" eq "1 1,1212" ? "ok $test\n" : "not ok $test\n";
-    $test++;
+    cmp_ok( "@x,$y",'eq',"1 1,1212", '[perl #17771] for in map 1');
+
     $y = '';
     @x = map { $y .= $_ for 1..2; $y .= $_ } 3..4;
-    print "# @x,$y\n";
-    print "@x,$y" eq "123 123124,123124" ? "ok $test\n" : "not ok $test\n";
-    $test++;
+    cmp_ok( "@x,$y",'eq',"123 123124,123124", '[perl #17771] for in map 2');
+
     $y = '';
     @x = map { for (1..2) { $y .= $_ } $y .= $_ } 3..4;
-    print "# @x,$y\n";
-    print "@x,$y" eq "123 123124,123124" ? "ok $test\n" : "not ok $test\n";
-    $test++;
+    cmp_ok( "@x,$y",'eq',"123 123124,123124", '[perl #17771] for in map 3');
+
     $y = '';
     @x = grep { $y .= $_ for 1..2; 1 } 3..4;
-    print "# @x,$y\n";
-    print "@x,$y" eq "3 4,1212" ? "ok $test\n" : "not ok $test\n";
-    $test++;
+    cmp_ok( "@x,$y",'eq',"3 4,1212", '[perl #17771] for in grep 1');
+
     $y = '';
     @x = grep { for (1..2) { $y .= $_ } 1 } 3..4;
-    print "# @x,$y\n";
-    print "@x,$y" eq "3 4,1212" ? "ok $test\n" : "not ok $test\n";
-    $test++;
+    cmp_ok( "@x,$y",'eq',"3 4,1212", '[perl #17771] for in grep 2');
 
     # Add also a sample test from [perl #18153].  (The same bug).
     $a = 1; map {if ($a){}} (2);
-    print "ok $test\n"; # no core dump is all we need
-    $test++;
+    pass( '[perl #18153] (not dead yet)' ); # no core dump is all we need
 }
 
 {
     sub add_an_x(@){
         map {"${_}x"} @_;
     };
-    ok join("-",add_an_x(1,2,3,4)), "1x-2x-3x-4x";
-    $test++;
+    cmp_ok( join("-",add_an_x(1,2,3,4)), 'eq', "1x-2x-3x-4x", 'add-an-x');
 }
 
 {
     my $gimme;
 
     sub gimme {
-	my $want = wantarray();
-	if (defined $want) {
-	    $gimme = $want ? 'list' : 'scalar';
-	} else {
-	    $gimme = 'void';
-	}
+        my $want = wantarray();
+        if (defined $want) {
+            $gimme = $want ? 'list' : 'scalar';
+        } else {
+            $gimme = 'void';
+        }
     }
 
     my @list = 0..9;
 
-    undef $gimme; gimme for @list;      ok($gimme, 'void');   $test++;
-    undef $gimme; grep { gimme } @list; ok($gimme, 'scalar'); $test++;
-    undef $gimme; map { gimme } @list;  ok($gimme, 'list');   $test++;
+    undef $gimme; gimme for @list;      cmp_ok($gimme, 'eq', 'void',   'gimme a V!');
+    undef $gimme; grep { gimme } @list; cmp_ok($gimme, 'eq', 'scalar', 'gimme an S!');
+    undef $gimme; map { gimme } @list;  cmp_ok($gimme, 'eq', 'list',   'gimme an L!');
+}
+
+{
+    # test scalar context return
+    my @list = (7, 14, 21);
+
+    my $x = map {$_ *= 2} @list;
+    cmp_ok("@list", 'eq', "14 28 42", 'map scalar return');
+    cmp_ok($x, '==', 3, 'map scalar count');
+
+    @list = (9, 16, 25, 36);
+    $x = grep {$_ % 2} @list;
+    cmp_ok($x, '==', 2, 'grep scalar count');
+
+    my @res = grep {$_ % 2} @list;
+    cmp_ok("@res", 'eq', "9 25", 'grep extract');
 }
 
 {
     # This shouldn't loop indefinitively.
     my @empty = map { while (1) {} } ();
-    ok("@empty", '');
+    cmp_ok("@empty", 'eq', '', 'staying alive');
 }