Commit | Line | Data |
fd3835b3 |
1 | #!./perl |
2 | |
3 | # |
4 | # grep() and map() tests |
5 | # |
6 | |
e3c9a8b9 |
7 | print "1..38\n"; |
fd3835b3 |
8 | |
9 | $test = 1; |
10 | |
11 | sub 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 | |
2c38e13d |
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 | } |
fb14229d |
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++; |
6c8d78fb |
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++; |
fb14229d |
136 | } |
6c8d78fb |
137 | |
b3c0f1bd |
138 | { |
139 | sub add_an_x(@){ |
140 | map {"${_}x"} @_; |
141 | }; |
142 | ok join("-",add_an_x(1,2,3,4)), "1x-2x-3x-4x"; |
20c514ec |
143 | $test++; |
b3c0f1bd |
144 | } |
145 | |
20c514ec |
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 | } |
b3c0f1bd |
164 | |
e3c9a8b9 |
165 | { |
166 | # This shouldn't loop indefinitively. |
167 | my @empty = map { while (1) {} } (); |
168 | ok("@empty", ''); |
169 | } |