This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
wince yet another step
[perl5.git] / t / op / grep.t
1 #!./perl
2
3 #
4 # grep() and map() tests
5 #
6
7 print "1..38\n";
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
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 }