Update Time-HiRes Changes for 1.9760
[perl.git] / t / op / grep.t
1 #!./perl
2
3 #
4 # grep() and map() tests
5 #
6
7 BEGIN {
8     chdir 't' if -d 't'; 
9     require "./test.pl";
10     set_up_inc( qw(. ../lib) );
11 }
12
13 plan( tests => 67 );
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
219 grep is(\$_, \$_, '[perl #78194] \$_ == \$_ inside grep ..., "$x"'),
220      "${\''}", "${\''}";
221 map 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 }
230 pass 'no double frees with grep/map { undef *_ }';
231
232 # Don't mortalise PADTMPs.
233 # This failed while I was messing with leave stuff (but not in a simple
234 # test, so add one). The '1;' ensures the block is wrapped in ENTER/LEAVE;
235 # the stringify returns a PADTMP. DAPM.
236
237 {
238     my @a = map { 1; "$_" } 1,2;
239     is("@a", "1 2", "PADTMP");
240 }