1N/A#!./perl
1N/A
1N/A#
1N/A# grep() and map() tests
1N/A#
1N/A
1N/Aprint "1..38\n";
1N/A
1N/A$test = 1;
1N/A
1N/Asub ok {
1N/A my ($got,$expect) = @_;
1N/A print "# expected [$expect], got [$got]\nnot " if $got ne $expect;
1N/A print "ok $test\n";
1N/A}
1N/A
1N/A{
1N/A my @lol = ([qw(a b c)], [], [qw(1 2 3)]);
1N/A my @mapped = map {scalar @$_} @lol;
1N/A ok "@mapped", "3 0 3";
1N/A $test++;
1N/A
1N/A my @grepped = grep {scalar @$_} @lol;
1N/A ok "@grepped", "$lol[0] $lol[2]";
1N/A $test++;
1N/A
1N/A @grepped = grep { $_ } @mapped;
1N/A ok "@grepped", "3 3";
1N/A $test++;
1N/A}
1N/A
1N/A{
1N/A print map({$_} ("ok $test\n"));
1N/A $test++;
1N/A print map
1N/A ({$_} ("ok $test\n"));
1N/A $test++;
1N/A print((map({a => $_}, ("ok $test\n")))[0]->{a});
1N/A $test++;
1N/A print((map
1N/A ({a=>$_},
1N/A ("ok $test\n")))[0]->{a});
1N/A $test++;
1N/A print map { $_ } ("ok $test\n");
1N/A $test++;
1N/A print map
1N/A { $_ } ("ok $test\n");
1N/A $test++;
1N/A print((map {a => $_}, ("ok $test\n"))[0]->{a});
1N/A $test++;
1N/A print((map
1N/A {a=>$_},
1N/A ("ok $test\n"))[0]->{a});
1N/A $test++;
1N/A my $x = "ok \xFF\xFF\n";
1N/A print map($_&$x,("ok $test\n"));
1N/A $test++;
1N/A print map
1N/A ($_ & $x, ("ok $test\n"));
1N/A $test++;
1N/A print map { $_ & $x } ("ok $test\n");
1N/A $test++;
1N/A print map
1N/A { $_&$x } ("ok $test\n");
1N/A $test++;
1N/A
1N/A print grep({$_} ("ok $test\n"));
1N/A $test++;
1N/A print grep
1N/A ({$_} ("ok $test\n"));
1N/A $test++;
1N/A print grep({a => $_}->{a}, ("ok $test\n"));
1N/A $test++;
1N/A print grep
1N/A ({a => $_}->{a},
1N/A ("ok $test\n"));
1N/A $test++;
1N/A print grep { $_ } ("ok $test\n");
1N/A $test++;
1N/A print grep
1N/A { $_ } ("ok $test\n");
1N/A $test++;
1N/A print grep {a => $_}->{a}, ("ok $test\n");
1N/A $test++;
1N/A print grep
1N/A {a => $_}->{a},
1N/A ("ok $test\n");
1N/A $test++;
1N/A print grep($_&"X",("ok $test\n"));
1N/A $test++;
1N/A print grep
1N/A ($_&"X", ("ok $test\n"));
1N/A $test++;
1N/A print grep { $_ & "X" } ("ok $test\n");
1N/A $test++;
1N/A print grep
1N/A { $_ & "X" } ("ok $test\n");
1N/A $test++;
1N/A}
1N/A
1N/A# Tests for "for" in "map" and "grep"
1N/A# Used to dump core, bug [perl #17771]
1N/A
1N/A{
1N/A my @x;
1N/A my $y = '';
1N/A @x = map { $y .= $_ for 1..2; 1 } 3..4;
1N/A print "# @x,$y\n";
1N/A print "@x,$y" eq "1 1,1212" ? "ok $test\n" : "not ok $test\n";
1N/A $test++;
1N/A $y = '';
1N/A @x = map { $y .= $_ for 1..2; $y .= $_ } 3..4;
1N/A print "# @x,$y\n";
1N/A print "@x,$y" eq "123 123124,123124" ? "ok $test\n" : "not ok $test\n";
1N/A $test++;
1N/A $y = '';
1N/A @x = map { for (1..2) { $y .= $_ } $y .= $_ } 3..4;
1N/A print "# @x,$y\n";
1N/A print "@x,$y" eq "123 123124,123124" ? "ok $test\n" : "not ok $test\n";
1N/A $test++;
1N/A $y = '';
1N/A @x = grep { $y .= $_ for 1..2; 1 } 3..4;
1N/A print "# @x,$y\n";
1N/A print "@x,$y" eq "3 4,1212" ? "ok $test\n" : "not ok $test\n";
1N/A $test++;
1N/A $y = '';
1N/A @x = grep { for (1..2) { $y .= $_ } 1 } 3..4;
1N/A print "# @x,$y\n";
1N/A print "@x,$y" eq "3 4,1212" ? "ok $test\n" : "not ok $test\n";
1N/A $test++;
1N/A
1N/A # Add also a sample test from [perl #18153]. (The same bug).
1N/A $a = 1; map {if ($a){}} (2);
1N/A print "ok $test\n"; # no core dump is all we need
1N/A $test++;
1N/A}
1N/A
1N/A{
1N/A sub add_an_x(@){
1N/A map {"${_}x"} @_;
1N/A };
1N/A ok join("-",add_an_x(1,2,3,4)), "1x-2x-3x-4x";
1N/A $test++;
1N/A}
1N/A
1N/A{
1N/A my $gimme;
1N/A
1N/A sub gimme {
1N/A my $want = wantarray();
1N/A if (defined $want) {
1N/A $gimme = $want ? 'list' : 'scalar';
1N/A } else {
1N/A $gimme = 'void';
1N/A }
1N/A }
1N/A
1N/A my @list = 0..9;
1N/A
1N/A undef $gimme; gimme for @list; ok($gimme, 'void'); $test++;
1N/A undef $gimme; grep { gimme } @list; ok($gimme, 'scalar'); $test++;
1N/A undef $gimme; map { gimme } @list; ok($gimme, 'list'); $test++;
1N/A}
1N/A
1N/A{
1N/A # This shouldn't loop indefinitively.
1N/A my @empty = map { while (1) {} } ();
1N/A ok("@empty", '');
1N/A}