t/22-call.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 43;
   7
   8 use Sub::Nary;
   9
  10 my $sn = Sub::Nary->new();
  11
  12 my $x;
  13
  14 sub CORE::GLOBAL::reset {
  15  return 1, 2, 3
  16 }
  17
  18 sub zero { }
  19 sub one  { 1 }
  20 sub two  { 1, 2 }
  21 sub lots { @_ }
  22
  23 sub rec { rec(); }
  24
  25 sub rec1 { rec2(); }
  26 sub rec2 { rec1(); }
  27
  28 my @tests = (
  29  [ sub { hlaghlaghlagh() }, 'list' ],
  30
  31  [ sub { zero }, 0 ],
  32  [ sub { one  }, 1 ],
  33  [ sub { two  }, 2 ],
  34  [ sub { lots }, 'list' ],
  35
  36  [ sub { one, zero, two }, 3 ],
  37  [ sub { one, lots },      'list' ],
  38  [ sub { lots, two },      'list' ],
  39
  40  [ sub { do { one, do { two } } },  3 ],
  41  [ sub { do { lots, do { one } } }, 'list' ],
  42
  43  [ sub { 1, return two, do { 4 } },         3 ],
  44  [ sub { two 1, return 2 },                 1 ],
  45  [ sub { two 1, do { return 5 if $x; 3 } }, { 1 => 0.5, 2 => 0.5 } ],
  46
  47  [ sub { 1, one(), 2 },   3 ],
  48  [ sub { 1, one(), @_ },  'list' ],
  49  [ sub { $_[0], two() },  3 ],
  50  [ sub { my $x = two() }, 1 ],
  51  [ sub { my @a = two() }, 2 ],
  52
  53  [ sub { 1, do { two, 1 }, do { one }, @_[0, 1] }, 7 ],
  54  [ sub { 1, do { two, 1, do { one, @_[0, 1] } } }, 7 ],
  55
  56  [ sub { $_[0]->what },                'list' ],
  57  [ sub { my $m = $_[1]; $_[0]->$m() }, 'list' ],
  58  [ sub { $_[0]->() },                  'list' ],
  59  [ sub { &two },                       2 ],
  60  [ sub { goto &two },                  2 ],
  61  [ sub { my $x = $_[0]; goto &$x },    'list' ],
  62  [ sub { FOO: goto FOO, 1 },           'list' ],
  63
  64  [ sub { rec() },                      'list' ],
  65  [ sub { rec1() },                     'list' ],
  66
  67  [ sub { sub { 1, 2 }, 2, 3 },                                      3 ],
  68  [ sub { sub { 1, 2 }->() },                                        2 ],
  69  [ sub { sub { 1, 2 }->(), 1, 2 },                                  4 ],
  70  [ sub { do { sub { 1, 2 } }->(), 3 },                              3 ],
  71  [ sub { do { my $x = sub { }; sub { 1, 2 } }->(), 3 },             3 ],
  72  [ sub { do { my $x = \&zero; sub { 1, 2 } }->(), 3 },              3 ],
  73  [ sub { do { my $x = 1; do { my $y = 2; sub { 1, 2 } } }->(), 3 }, 3 ],
  74  [ sub { sub { sub { 1, 2 } }->()->() },                            'list' ],
  75  [ sub { sub { sub { 1, 2 }->(), 3 }->(), 4 },                      4 ],
  76
  77  [ sub { \&zero },          1 ],
  78  [ sub { *zero },           1 ],
  79  [ sub { *zero{CODE}->() }, 'list' ],
  80
  81  [ sub { &CORE::GLOBAL::shift }, 'list' ],
  82  [ sub { &CORE::GLOBAL::reset }, 3 ],
  83 );
  84
  85 my $i = 1;
  86 for (@tests) {
  87  my $r = $sn->nary($_->[0]);
  88  my $exp = ref $_->[1] ? $_->[1] : { $_->[1] => 1 };
  89  is_deeply($r, $exp, 'call test ' . $i);
  90  ++$i;
  91 }