Commit | Line | Data |
---|---|---|
fd3835b3 GS |
1 | #!./perl |
2 | ||
3 | # | |
4 | # grep() and map() tests | |
5 | # | |
6 | ||
cb9881c1 RGS |
7 | BEGIN { |
8 | chdir 't' if -d 't'; | |
9 | @INC = qw(. ../lib); | |
fd3835b3 GS |
10 | } |
11 | ||
cb9881c1 RGS |
12 | require "test.pl"; |
13 | plan( tests => 60 ); | |
14 | ||
fd3835b3 | 15 | { |
cb9881c1 RGS |
16 | my @lol = ([qw(a b c)], [], [qw(1 2 3)]); |
17 | my @mapped = map {scalar @$_} @lol; | |
18 | cmp_ok("@mapped", 'eq', "3 0 3", 'map scalar list of list'); | |
19 | ||
20 | my @grepped = grep {scalar @$_} @lol; | |
21 | cmp_ok("@grepped", 'eq', "$lol[0] $lol[2]", 'grep scalar list of list'); | |
22 | $test++; | |
23 | ||
24 | @grepped = grep { $_ } @mapped; | |
25 | cmp_ok( "@grepped", 'eq', "3 3", 'grep basic'); | |
fd3835b3 GS |
26 | } |
27 | ||
2c38e13d | 28 | { |
cb9881c1 RGS |
29 | my @res; |
30 | ||
31 | @res = map({$_} ("geronimo")); | |
32 | cmp_ok( scalar(@res), '==', 1, 'basic map nr'); | |
33 | cmp_ok( $res[0], 'eq', 'geronimo', 'basic map is'); | |
34 | ||
35 | @res = map | |
36 | ({$_} ("yoyodyne")); | |
37 | cmp_ok( scalar(@res), '==', 1, 'linefeed map nr'); | |
38 | cmp_ok( $res[0], 'eq', 'yoyodyne', 'linefeed map is'); | |
39 | ||
40 | @res = (map( | |
41 | {a =>$_}, | |
42 | ("chobb")))[0]->{a}; | |
43 | cmp_ok( scalar(@res), '==', 1, 'deref map nr'); | |
44 | cmp_ok( $res[0], 'eq', 'chobb', 'deref map is'); | |
45 | ||
46 | @res = map {$_} ("geronimo"); | |
47 | cmp_ok( scalar(@res), '==', 1, 'no paren basic map nr'); | |
48 | cmp_ok( $res[0], 'eq', 'geronimo', 'no paren basic map is'); | |
49 | ||
50 | @res = map | |
51 | {$_} ("yoyodyne"); | |
52 | cmp_ok( scalar(@res), '==', 1, 'no paren linefeed map nr'); | |
53 | cmp_ok( $res[0], 'eq', 'yoyodyne', 'no paren linefeed map is'); | |
54 | ||
55 | @res = (map | |
56 | {a =>$_}, | |
57 | ("chobb"))[0]->{a}; | |
58 | cmp_ok( scalar(@res), '==', 1, 'no paren deref map nr'); | |
59 | cmp_ok( $res[0], 'eq', 'chobb', 'no paren deref map is'); | |
60 | ||
61 | my $x = "\xFF\xFF\xFF\xFF\xFF\xFF\xFF\n"; | |
62 | ||
63 | @res = map($_&$x,("sferics\n")); | |
64 | cmp_ok( scalar(@res), '==', 1, 'binand map nr 1'); | |
65 | cmp_ok( $res[0], 'eq', "sferics\n", 'binand map is 1'); | |
66 | ||
67 | @res = map | |
68 | ($_ & $x, ("sferics\n")); | |
69 | cmp_ok( scalar(@res), '==', 1, 'binand map nr 2'); | |
70 | cmp_ok( $res[0], 'eq', "sferics\n", 'binand map is 2'); | |
71 | ||
72 | @res = map { $_ & $x } ("sferics\n"); | |
73 | cmp_ok( scalar(@res), '==', 1, 'binand map nr 3'); | |
74 | cmp_ok( $res[0], 'eq', "sferics\n", 'binand map is 3'); | |
75 | ||
76 | @res = map | |
77 | { $_&$x } ("sferics\n"); | |
78 | cmp_ok( scalar(@res), '==', 1, 'binand map nr 4'); | |
79 | cmp_ok( $res[0], 'eq', "sferics\n", 'binand map is 4'); | |
80 | ||
81 | @res = grep({$_} ("geronimo")); | |
82 | cmp_ok( scalar(@res), '==', 1, 'basic grep nr'); | |
83 | cmp_ok( $res[0], 'eq', 'geronimo', 'basic grep is'); | |
84 | ||
85 | @res = grep | |
86 | ({$_} ("yoyodyne")); | |
87 | cmp_ok( scalar(@res), '==', 1, 'linefeed grep nr'); | |
88 | cmp_ok( $res[0], 'eq', 'yoyodyne', 'linefeed grep is'); | |
89 | ||
90 | @res = grep | |
91 | ({a=>$_}->{a}, | |
92 | ("chobb")); | |
93 | cmp_ok( scalar(@res), '==', 1, 'deref grep nr'); | |
94 | cmp_ok( $res[0], 'eq', 'chobb', 'deref grep is'); | |
95 | ||
96 | @res = grep {$_} ("geronimo"); | |
97 | cmp_ok( scalar(@res), '==', 1, 'no paren basic grep nr'); | |
98 | cmp_ok( $res[0], 'eq', 'geronimo', 'no paren basic grep is'); | |
99 | ||
100 | @res = grep | |
101 | {$_} ("yoyodyne"); | |
102 | cmp_ok( scalar(@res), '==', 1, 'no paren linefeed grep nr'); | |
103 | cmp_ok( $res[0], 'eq', 'yoyodyne', 'no paren linefeed grep is'); | |
104 | ||
105 | @res = grep {a=>$_}->{a}, ("chobb"); | |
106 | cmp_ok( scalar(@res), '==', 1, 'no paren deref grep nr'); | |
107 | cmp_ok( $res[0], 'eq', 'chobb', 'no paren deref grep is'); | |
108 | ||
109 | @res = grep | |
110 | {a=>$_}->{a}, ("chobb"); | |
111 | cmp_ok( scalar(@res), '==', 1, 'no paren deref linefeed nr'); | |
112 | cmp_ok( $res[0], 'eq', 'chobb', 'no paren deref linefeed is'); | |
113 | ||
114 | @res = grep($_&"X", ("bodine")); | |
115 | cmp_ok( scalar(@res), '==', 1, 'binand X grep nr'); | |
116 | cmp_ok( $res[0], 'eq', 'bodine', 'binand X grep is'); | |
117 | ||
118 | @res = grep | |
119 | ($_&"X", ("bodine")); | |
120 | cmp_ok( scalar(@res), '==', 1, 'binand X linefeed grep nr'); | |
121 | cmp_ok( $res[0], 'eq', 'bodine', 'binand X linefeed grep is'); | |
122 | ||
123 | @res = grep {$_&"X"} ("bodine"); | |
124 | cmp_ok( scalar(@res), '==', 1, 'no paren binand X grep nr'); | |
125 | cmp_ok( $res[0], 'eq', 'bodine', 'no paren binand X grep is'); | |
126 | ||
127 | @res = grep | |
128 | {$_&"X"} ("bodine"); | |
129 | cmp_ok( scalar(@res), '==', 1, 'no paren binand X linefeed grep nr'); | |
130 | cmp_ok( $res[0], 'eq', 'bodine', 'no paren binand X linefeed grep is'); | |
2c38e13d | 131 | } |
fb14229d | 132 | |
fb14229d | 133 | { |
cb9881c1 RGS |
134 | # Tests for "for" in "map" and "grep" |
135 | # Used to dump core, bug [perl #17771] | |
136 | ||
fb14229d RGS |
137 | my @x; |
138 | my $y = ''; | |
139 | @x = map { $y .= $_ for 1..2; 1 } 3..4; | |
cb9881c1 RGS |
140 | cmp_ok( "@x,$y",'eq',"1 1,1212", '[perl #17771] for in map 1'); |
141 | ||
fb14229d RGS |
142 | $y = ''; |
143 | @x = map { $y .= $_ for 1..2; $y .= $_ } 3..4; | |
cb9881c1 RGS |
144 | cmp_ok( "@x,$y",'eq',"123 123124,123124", '[perl #17771] for in map 2'); |
145 | ||
fb14229d RGS |
146 | $y = ''; |
147 | @x = map { for (1..2) { $y .= $_ } $y .= $_ } 3..4; | |
cb9881c1 RGS |
148 | cmp_ok( "@x,$y",'eq',"123 123124,123124", '[perl #17771] for in map 3'); |
149 | ||
fb14229d RGS |
150 | $y = ''; |
151 | @x = grep { $y .= $_ for 1..2; 1 } 3..4; | |
cb9881c1 RGS |
152 | cmp_ok( "@x,$y",'eq',"3 4,1212", '[perl #17771] for in grep 1'); |
153 | ||
fb14229d RGS |
154 | $y = ''; |
155 | @x = grep { for (1..2) { $y .= $_ } 1 } 3..4; | |
cb9881c1 | 156 | cmp_ok( "@x,$y",'eq',"3 4,1212", '[perl #17771] for in grep 2'); |
6c8d78fb HS |
157 | |
158 | # Add also a sample test from [perl #18153]. (The same bug). | |
159 | $a = 1; map {if ($a){}} (2); | |
cb9881c1 | 160 | pass( '[perl #18153] (not dead yet)' ); # no core dump is all we need |
fb14229d | 161 | } |
6c8d78fb | 162 | |
b3c0f1bd DN |
163 | { |
164 | sub add_an_x(@){ | |
165 | map {"${_}x"} @_; | |
166 | }; | |
cb9881c1 | 167 | cmp_ok( join("-",add_an_x(1,2,3,4)), 'eq', "1x-2x-3x-4x", 'add-an-x'); |
b3c0f1bd DN |
168 | } |
169 | ||
20c514ec JH |
170 | { |
171 | my $gimme; | |
172 | ||
173 | sub gimme { | |
cb9881c1 RGS |
174 | my $want = wantarray(); |
175 | if (defined $want) { | |
176 | $gimme = $want ? 'list' : 'scalar'; | |
177 | } else { | |
178 | $gimme = 'void'; | |
179 | } | |
20c514ec JH |
180 | } |
181 | ||
182 | my @list = 0..9; | |
183 | ||
cb9881c1 RGS |
184 | undef $gimme; gimme for @list; cmp_ok($gimme, 'eq', 'void', 'gimme a V!'); |
185 | undef $gimme; grep { gimme } @list; cmp_ok($gimme, 'eq', 'scalar', 'gimme an S!'); | |
186 | undef $gimme; map { gimme } @list; cmp_ok($gimme, 'eq', 'list', 'gimme an L!'); | |
187 | } | |
188 | ||
189 | { | |
190 | # test scalar context return | |
191 | my @list = (7, 14, 21); | |
192 | ||
193 | my $x = map {$_ *= 2} @list; | |
194 | cmp_ok("@list", 'eq', "14 28 42", 'map scalar return'); | |
195 | cmp_ok($x, '==', 3, 'map scalar count'); | |
196 | ||
197 | @list = (9, 16, 25, 36); | |
198 | $x = grep {$_ % 2} @list; | |
199 | cmp_ok($x, '==', 2, 'grep scalar count'); | |
200 | ||
201 | my @res = grep {$_ % 2} @list; | |
202 | cmp_ok("@res", 'eq', "9 25", 'grep extract'); | |
20c514ec | 203 | } |
b3c0f1bd | 204 | |
e3c9a8b9 RGS |
205 | { |
206 | # This shouldn't loop indefinitively. | |
207 | my @empty = map { while (1) {} } (); | |
cb9881c1 | 208 | cmp_ok("@empty", 'eq', '', 'staying alive'); |
e3c9a8b9 | 209 | } |