t/op/grep.t

   1 #!./perl
   2
   3 #
   4 # grep() and map() tests
   5 #
   6
   7 BEGIN {
   8     chdir 't' if -d 't';
   9     @INC = qw(. ../lib);
  10     require "test.pl";
  11 }
  12
  13 plan( 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
 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 *_ }';