xref: /openbsd/gnu/usr.bin/perl/t/op/grep.t (revision a6445c1d) 
1#!./perl
2
3#
4# grep() and map() tests
5#
6
7BEGIN {
8    chdir 't' if -d 't';
9    @INC = qw(. ../lib);
10    require "test.pl";
11}
12
13plan( tests => 66 );
14
15{
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');
26}
27
28{
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');
131}
132
133{
134    # Tests for "for" in "map" and "grep"
135    # Used to dump core, bug [perl #17771]
136
137    my @x;
138    my $y = '';
139    @x = map { $y .= $_ for 1..2; 1 } 3..4;
140    cmp_ok( "@x,$y",'eq',"1 1,1212", '[perl #17771] for in map 1');
141
142    $y = '';
143    @x = map { $y .= $_ for 1..2; $y .= $_ } 3..4;
144    cmp_ok( "@x,$y",'eq',"123 123124,123124", '[perl #17771] for in map 2');
145
146    $y = '';
147    @x = map { for (1..2) { $y .= $_ } $y .= $_ } 3..4;
148    cmp_ok( "@x,$y",'eq',"123 123124,123124", '[perl #17771] for in map 3');
149
150    $y = '';
151    @x = grep { $y .= $_ for 1..2; 1 } 3..4;
152    cmp_ok( "@x,$y",'eq',"3 4,1212", '[perl #17771] for in grep 1');
153
154    $y = '';
155    @x = grep { for (1..2) { $y .= $_ } 1 } 3..4;
156    cmp_ok( "@x,$y",'eq',"3 4,1212", '[perl #17771] for in grep 2');
157
158    # Add also a sample test from [perl #18153].  (The same bug).
159    $a = 1; map {if ($a){}} (2);
160    pass( '[perl #18153] (not dead yet)' ); # no core dump is all we need
161}
162
163{
164    sub add_an_x(@){
165        map {"${_}x"} @_;
166    };
167    cmp_ok( join("-",add_an_x(1,2,3,4)), 'eq', "1x-2x-3x-4x", 'add-an-x');
168}
169
170{
171    my $gimme;
172
173    sub gimme {
174        my $want = wantarray();
175        if (defined $want) {
176            $gimme = $want ? 'list' : 'scalar';
177        } else {
178            $gimme = 'void';
179        }
180    }
181
182    my @list = 0..9;
183
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');
203}
204
205{
206    # This shouldn't loop indefinitely.
207    my @empty = map { while (1) {} } ();
208    cmp_ok("@empty", 'eq', '', 'staying alive');
209}
210
211{
212    my $x;
213    eval 'grep $x (1,2,3);';
214    like($@, qr/Missing comma after first argument to grep function/,
215         "proper error on variable as block. [perl #37314]");
216}
217
218# [perl #78194] grep/map aliasing op return values
219grep is(\$_, \$_, '[perl #78194] \$_ == \$_ inside grep ..., "$x"'),
220     "${\''}", "${\''}";
221map is(\$_, \$_, '[perl #78194] \$_ == \$_ inside map ..., "$x"'),
222     "${\''}", "${\''}";
223
224# [perl #92254] freeing $_ in gremap block
225{
226    my $y;
227    grep { undef *_ } $y;
228    map { undef *_ } $y;
229}
230pass 'no double frees with grep/map { undef *_ }';
231