t/24-ops.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 49;
   7
   8 use Sub::Nary;
   9
  10 my $sn = Sub::Nary->new();
  11
  12 my ($x, %h);
  13
  14 sub zeroorone {
  15  return (rand() < 0.1) ? () : 1;
  16 }
  17
  18 sub oneortwo {
  19  if (rand() < 0.1) {
  20   return 3
  21  } else {
  22   4, 5
  23  }
  24 }
  25
  26 sub onetwothree {
  27  my $r = rand();
  28  if ($r < 0.1) {
  29   return 3
  30  } elsif ($r < 0.9) {
  31   return 4, 5
  32  }
  33  return 4, do { 5, 6 };
  34 }
  35
  36 # { 1 => 0.5, 2 => 0.5 } * 0.5 + { 2 => 0.25, 3 => 0.5, 4 => 0.25 } * 0.5
  37 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 };
  38
  39 # { 1 => 0.5, 2 => 0.25, 3 => 0.25 } * 0.5 + { 2 => 0.25, 3 => 0.25, 4 => 0.3125, 5 => 0.125, 6 => 0.0625 } * 0.5
  40 my $exp_32 = { 1 => 0.5/2, 2 => (0.25+0.25)/2, 3 => (0.25+0.25)/2, 4 => (0.3125)/2, 5 => (0.125)/2, 6 => (0.0625)/2 };
  41
  42 my $b3 = 0.5 ** 3;
  43 my $exp_23 = { 3 => $b3, 4 => 3 * $b3, 5 => 3 * $b3, 6 => $b3 };
  44
  45 my @tests = (
  46  [ sub { delete $h{foo} },             1 ],
  47  [ sub { delete @h{qw/foo bar baz/} }, 3 ],
  48
  49  [ sub { grep { 1 } 1 .. 10 }, 'list' ],
  50  [ sub { grep { 1 } @_ },      'list' ],
  51
  52  [ sub { map { $_ } 1 .. 3 },                       3 ],
  53  [ sub { map { () } @_ },                           0 ],
  54  [ sub { map { @_ } () },                           0 ],
  55  [ sub { map { @_ } 1, 2 },                         'list' ],
  56  [ sub { map { $_ } oneortwo() },                   { 1 => 0.5, 2 => 0.5 } ],
  57  [ sub { map { $_ ? 7 : (8, 9) } 1 .. 3 },          $exp_23 ],
  58  [ sub { map oneortwo, 1 .. 3 },                    $exp_23 ],
  59  [ sub { map oneortwo, @_ },                        'list' ],
  60  [ sub { map zeroorone, @_ },                       { 0 => 0.5, list => 0.5 } ],
  61  [ sub { map { $_ ? () : 12 } do { $x ? 7 : () } }, { 0 => 0.75, 1 => 0.25 } ],
  62  [ sub { map zeroorone, do { $x ? 7 : () } },       { 0 => 0.75, 1 => 0.25 } ],
  63  [ sub { map oneortwo, oneortwo },                  $exp_22 ],
  64  [ sub { map onetwothree, oneortwo },               $exp_32 ],
  65
  66  [ sub { return <$x> }, 'list' ],
  67
  68  [ sub { -f $0, -r $0 }, 2 ],
  69
  70  [ sub { return caller 0 },  sub { my @a = caller 0; scalar @a }->() ],
  71  [ sub { return localtime }, do { my @a = localtime; scalar @a } ],
  72  [ sub { gmtime },           do { my @a = gmtime; scalar @a } ],
  73
  74  [ sub { each %h }, { 0 => 0.5, 2 => 0.5 } ],
  75  [ sub { stat $0 }, { 0 => 0.5, 13 => 0.5 } ],
  76
  77  [ sub { do { getpwnam 'root' } },            { 0 => 0.5, 10 => 0.5 } ],
  78  [ sub { 1; getpwuid '0' },                   { 0 => 0.5, 10 => 0.5 } ],
  79  [ sub { eval { return getpwent } },          { 0 => 0.5, 10 => 0.5 } ],
  80
  81  [ sub { do { getgrnam 'root' } },            { 0 => 0.5, 4 => 0.5 } ],
  82  [ sub { 1; getgrgid '0' },                   { 0 => 0.5, 4 => 0.5 } ],
  83  [ sub { eval { return getgrent } },          { 0 => 0.5, 4 => 0.5 } ],
  84
  85  [ sub { do { gethostbyname 'localhost' } },  'list' ],
  86  [ sub { 1; gethostbyaddr '', '' },           'list' ],
  87  [ sub { eval { return gethostent } },        'list' ],
  88
  89  [ sub { do { getnetbyname '' } },            { 0 => 0.5, 4 => 0.5 } ],
  90  [ sub { 1; getnetbyaddr '', '' },            { 0 => 0.5, 4 => 0.5 } ],
  91  [ sub { eval { return getnetent } },         { 0 => 0.5, 4 => 0.5 } ],
  92
  93  [ sub { do { getprotobyname 'tcp' } },       { 0 => 0.5, 3 => 0.5 } ],
  94  [ sub { 1; getprotobynumber 6 },             { 0 => 0.5, 3 => 0.5 } ],
  95  [ sub { eval { return getprotoent } },       { 0 => 0.5, 3 => 0.5 } ],
  96
  97  [ sub { do { getservbyname 'ssh', 'tcp' } }, { 0 => 0.5, 4 => 0.5 } ],
  98  [ sub { 1; getservbyport 22, 'tcp' },        { 0 => 0.5, 4 => 0.5 } ],
  99  [ sub { eval { return getservent } },        { 0 => 0.5, 4 => 0.5 } ],
 100
 101  [ sub { endpwent },    1 ],
 102  [ sub { endgrent },    1 ],
 103  [ sub { endhostent },  1 ],
 104  [ sub { endnetent },   1 ],
 105  [ sub { endprotoent }, 1 ],
 106  [ sub { endservent },  1 ],
 107
 108  [ sub { <*.*> }, { list => 0.5, 1 => 0.5 } ],
 109 );
 110
 111 my $i = 1;
 112 for (@tests) {
 113  my $r = $sn->nary($_->[0]);
 114  my $exp = ref $_->[1] ? $_->[1] : { $_->[1] => 1 };
 115  is_deeply($r, $exp, 'ops test ' . $i);
 116  ++$i;
 117 }