X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fop%2Fgrep.t;h=3e5d7168a0dc17b78398ccea579469c62277a1b8;hb=e081bb54e0eecfb962e7f0cfd84fcbdb2683d54d;hp=45d0e25a27cfea3620b7faa004ecd36ac84bf85d;hpb=fd3835b3e90ede5576a7ad392beef86bf933ce15;p=p5sagit%2Fp5-mst-13.2.git diff --git a/t/op/grep.t b/t/op/grep.t index 45d0e25..3e5d716 100755 --- a/t/op/grep.t +++ b/t/op/grep.t @@ -4,7 +4,7 @@ # grep() and map() tests # -print "1..3\n"; +print "1..38\n"; $test = 1; @@ -29,3 +29,141 @@ sub ok { $test++; } +{ + print map({$_} ("ok $test\n")); + $test++; + print map + ({$_} ("ok $test\n")); + $test++; + print((map({a => $_}, ("ok $test\n")))[0]->{a}); + $test++; + print((map + ({a=>$_}, + ("ok $test\n")))[0]->{a}); + $test++; + print map { $_ } ("ok $test\n"); + $test++; + print map + { $_ } ("ok $test\n"); + $test++; + print((map {a => $_}, ("ok $test\n"))[0]->{a}); + $test++; + print((map + {a=>$_}, + ("ok $test\n"))[0]->{a}); + $test++; + my $x = "ok \xFF\xFF\n"; + print map($_&$x,("ok $test\n")); + $test++; + print map + ($_ & $x, ("ok $test\n")); + $test++; + print map { $_ & $x } ("ok $test\n"); + $test++; + print map + { $_&$x } ("ok $test\n"); + $test++; + + print grep({$_} ("ok $test\n")); + $test++; + print grep + ({$_} ("ok $test\n")); + $test++; + print grep({a => $_}->{a}, ("ok $test\n")); + $test++; + print grep + ({a => $_}->{a}, + ("ok $test\n")); + $test++; + print grep { $_ } ("ok $test\n"); + $test++; + print grep + { $_ } ("ok $test\n"); + $test++; + print grep {a => $_}->{a}, ("ok $test\n"); + $test++; + print grep + {a => $_}->{a}, + ("ok $test\n"); + $test++; + print grep($_&"X",("ok $test\n")); + $test++; + print grep + ($_&"X", ("ok $test\n")); + $test++; + print grep { $_ & "X" } ("ok $test\n"); + $test++; + print grep + { $_ & "X" } ("ok $test\n"); + $test++; +} + +# Tests for "for" in "map" and "grep" +# Used to dump core, bug [perl #17771] + +{ + my @x; + my $y = ''; + @x = map { $y .= $_ for 1..2; 1 } 3..4; + print "# @x,$y\n"; + print "@x,$y" eq "1 1,1212" ? "ok $test\n" : "not ok $test\n"; + $test++; + $y = ''; + @x = map { $y .= $_ for 1..2; $y .= $_ } 3..4; + print "# @x,$y\n"; + print "@x,$y" eq "123 123124,123124" ? "ok $test\n" : "not ok $test\n"; + $test++; + $y = ''; + @x = map { for (1..2) { $y .= $_ } $y .= $_ } 3..4; + print "# @x,$y\n"; + print "@x,$y" eq "123 123124,123124" ? "ok $test\n" : "not ok $test\n"; + $test++; + $y = ''; + @x = grep { $y .= $_ for 1..2; 1 } 3..4; + print "# @x,$y\n"; + print "@x,$y" eq "3 4,1212" ? "ok $test\n" : "not ok $test\n"; + $test++; + $y = ''; + @x = grep { for (1..2) { $y .= $_ } 1 } 3..4; + print "# @x,$y\n"; + print "@x,$y" eq "3 4,1212" ? "ok $test\n" : "not ok $test\n"; + $test++; + + # Add also a sample test from [perl #18153]. (The same bug). + $a = 1; map {if ($a){}} (2); + print "ok $test\n"; # no core dump is all we need + $test++; +} + +{ + sub add_an_x(@){ + map {"${_}x"} @_; + }; + ok join("-",add_an_x(1,2,3,4)), "1x-2x-3x-4x"; + $test++; +} + +{ + my $gimme; + + sub gimme { + my $want = wantarray(); + if (defined $want) { + $gimme = $want ? 'list' : 'scalar'; + } else { + $gimme = 'void'; + } + } + + my @list = 0..9; + + undef $gimme; gimme for @list; ok($gimme, 'void'); $test++; + undef $gimme; grep { gimme } @list; ok($gimme, 'scalar'); $test++; + undef $gimme; map { gimme } @list; ok($gimme, 'list'); $test++; +} + +{ + # This shouldn't loop indefinitively. + my @empty = map { while (1) {} } (); + ok("@empty", ''); +}