1#!./perl 2 3# 4# grep() and map() tests 5# 6 7print "1..38\n"; 8 9$test = 1; 10 11sub ok { 12 my ($got,$expect) = @_; 13 print "# expected [$expect], got [$got]\nnot " if $got ne $expect; 14 print "ok $test\n"; 15} 16 17{ 18 my @lol = ([qw(a b c)], [], [qw(1 2 3)]); 19 my @mapped = map {scalar @$_} @lol; 20 ok "@mapped", "3 0 3"; 21 $test++; 22 23 my @grepped = grep {scalar @$_} @lol; 24 ok "@grepped", "$lol[0] $lol[2]"; 25 $test++; 26 27 @grepped = grep { $_ } @mapped; 28 ok "@grepped", "3 3"; 29 $test++; 30} 31 32{ 33 print map({$_} ("ok $test\n")); 34 $test++; 35 print map 36 ({$_} ("ok $test\n")); 37 $test++; 38 print((map({a => $_}, ("ok $test\n")))[0]->{a}); 39 $test++; 40 print((map 41 ({a=>$_}, 42 ("ok $test\n")))[0]->{a}); 43 $test++; 44 print map { $_ } ("ok $test\n"); 45 $test++; 46 print map 47 { $_ } ("ok $test\n"); 48 $test++; 49 print((map {a => $_}, ("ok $test\n"))[0]->{a}); 50 $test++; 51 print((map 52 {a=>$_}, 53 ("ok $test\n"))[0]->{a}); 54 $test++; 55 my $x = "ok \xFF\xFF\n"; 56 print map($_&$x,("ok $test\n")); 57 $test++; 58 print map 59 ($_ & $x, ("ok $test\n")); 60 $test++; 61 print map { $_ & $x } ("ok $test\n"); 62 $test++; 63 print map 64 { $_&$x } ("ok $test\n"); 65 $test++; 66 67 print grep({$_} ("ok $test\n")); 68 $test++; 69 print grep 70 ({$_} ("ok $test\n")); 71 $test++; 72 print grep({a => $_}->{a}, ("ok $test\n")); 73 $test++; 74 print grep 75 ({a => $_}->{a}, 76 ("ok $test\n")); 77 $test++; 78 print grep { $_ } ("ok $test\n"); 79 $test++; 80 print grep 81 { $_ } ("ok $test\n"); 82 $test++; 83 print grep {a => $_}->{a}, ("ok $test\n"); 84 $test++; 85 print grep 86 {a => $_}->{a}, 87 ("ok $test\n"); 88 $test++; 89 print grep($_&"X",("ok $test\n")); 90 $test++; 91 print grep 92 ($_&"X", ("ok $test\n")); 93 $test++; 94 print grep { $_ & "X" } ("ok $test\n"); 95 $test++; 96 print grep 97 { $_ & "X" } ("ok $test\n"); 98 $test++; 99} 100 101# Tests for "for" in "map" and "grep" 102# Used to dump core, bug [perl #17771] 103 104{ 105 my @x; 106 my $y = ''; 107 @x = map { $y .= $_ for 1..2; 1 } 3..4; 108 print "# @x,$y\n"; 109 print "@x,$y" eq "1 1,1212" ? "ok $test\n" : "not ok $test\n"; 110 $test++; 111 $y = ''; 112 @x = map { $y .= $_ for 1..2; $y .= $_ } 3..4; 113 print "# @x,$y\n"; 114 print "@x,$y" eq "123 123124,123124" ? "ok $test\n" : "not ok $test\n"; 115 $test++; 116 $y = ''; 117 @x = map { for (1..2) { $y .= $_ } $y .= $_ } 3..4; 118 print "# @x,$y\n"; 119 print "@x,$y" eq "123 123124,123124" ? "ok $test\n" : "not ok $test\n"; 120 $test++; 121 $y = ''; 122 @x = grep { $y .= $_ for 1..2; 1 } 3..4; 123 print "# @x,$y\n"; 124 print "@x,$y" eq "3 4,1212" ? "ok $test\n" : "not ok $test\n"; 125 $test++; 126 $y = ''; 127 @x = grep { for (1..2) { $y .= $_ } 1 } 3..4; 128 print "# @x,$y\n"; 129 print "@x,$y" eq "3 4,1212" ? "ok $test\n" : "not ok $test\n"; 130 $test++; 131 132 # Add also a sample test from [perl #18153]. (The same bug). 133 $a = 1; map {if ($a){}} (2); 134 print "ok $test\n"; # no core dump is all we need 135 $test++; 136} 137 138{ 139 sub add_an_x(@){ 140 map {"${_}x"} @_; 141 }; 142 ok join("-",add_an_x(1,2,3,4)), "1x-2x-3x-4x"; 143 $test++; 144} 145 146{ 147 my $gimme; 148 149 sub gimme { 150 my $want = wantarray(); 151 if (defined $want) { 152 $gimme = $want ? 'list' : 'scalar'; 153 } else { 154 $gimme = 'void'; 155 } 156 } 157 158 my @list = 0..9; 159 160 undef $gimme; gimme for @list; ok($gimme, 'void'); $test++; 161 undef $gimme; grep { gimme } @list; ok($gimme, 'scalar'); $test++; 162 undef $gimme; map { gimme } @list; ok($gimme, 'list'); $test++; 163} 164 165{ 166 # This shouldn't loop indefinitively. 167 my @empty = map { while (1) {} } (); 168 ok("@empty", ''); 169} 170