X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FSub-Nary.git;a=blobdiff_plain;f=t%2F24-ops.t;h=506b55eb0b7ee0ab34eba418db55b6d4ba00d276;hp=f3f62f49337d65f48edab6aa609aab7a9993a0f7;hb=04997f51e7b0a73e04ef0c8df41d4ad045fc7584;hpb=c38c23a2c58ba8368464423760768887bfc6731f diff --git a/t/24-ops.t b/t/24-ops.t index f3f62f4..506b55e 100644 --- a/t/24-ops.t +++ b/t/24-ops.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 34; +use Test::More tests => 47; use Sub::Nary; @@ -11,10 +11,57 @@ my $sn = Sub::Nary->new(); my ($x, %h); +sub zeroorone { + return (rand() < 0.1) ? () : 1; +} + +sub oneortwo { + if (rand() < 0.1) { + return 3 + } else { + 4, 5 + } +} + +sub onetwothree { + my $r = rand(); + if ($r < 0.1) { + return 3 + } elsif ($r < 0.9) { + return 4, 5 + } + return 4, do { 5, 6 }; +} + +# { 1 => 0.5, 2 => 0.5 } * 0.5 + { 2 => 0.25, 3 => 0.5, 4 => 0.25 } * 0.5 +my $exp_22 = { 1 => 0.5 * 0.5, 2 => (0.5 + 0.25) * 0.5, 3 => 0.5 * 0.5, 4 => 0.25 * 0.5 }; + +# { 1 => 1/3, 2 => 1/3, 3 => 1/3 } * 0.5 + { 2 => 1/9, 3 => 2/9, 4 => 3/9, 5 => 2/9, 6 => 1/3 } * 0.5 +my $exp_32 = { 1 => 1/3/2, 2 => (1/3+1/9)/2, 3 => (1/3+2/9)/2, 4 => 3/9/2, 5 => 2/9/2, 6 => 1/3/2 }; + +my $b3 = 0.5 ** 3; +my $exp_23 = { 3 => $b3, 4 => 3 * $b3, 5 => 3 * $b3, 6 => $b3 }; + my @tests = ( [ sub { delete $h{foo} }, 1 ], [ sub { delete @h{qw/foo bar baz/} }, 3 ], + [ sub { grep { 1 } 1 .. 10 }, 'list' ], + + [ sub { map { $_ } 1 .. 3 }, 3 ], + [ sub { map { () } @_ }, 0 ], + [ sub { map { @_ } () }, 0 ], + [ sub { map { @_ } 1, 2 }, 'list' ], + [ sub { map { $_ } oneortwo() }, { 1 => 0.5, 2 => 0.5 } ], + [ sub { map { $_ ? 7 : (8, 9) } 1 .. 3 }, $exp_23 ], + [ sub { map oneortwo, 1 .. 3 }, $exp_23 ], + [ sub { map oneortwo, @_ }, 'list' ], + [ sub { map zeroorone, @_ }, { 0 => 0.5, list => 0.5 } ], + [ sub { map { $_ ? () : 12 } do { $x ? 7 : () } }, { 0 => 0.75, 1 => 0.25 } ], + [ sub { map zeroorone, do { $x ? 7 : () } }, { 0 => 0.75, 1 => 0.25 } ], + [ sub { map oneortwo, oneortwo }, $exp_22 ], + [ sub { map onetwothree, oneortwo }, $exp_32 ], + [ sub { return <$x> }, 'list' ], [ sub { -f $0, -r $0 }, 2 ],