t/23-branch.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 21 + ("$]" >= 5.010 ? 1 : 0);
   7
   8 use Sub::Nary;
   9
  10 my $sn = Sub::Nary->new();
  11
  12 my ($x, $y, @a, %h);
  13
  14 sub ret12 {
  15  if ($x) {
  16   return 1
  17  } else {
  18   return 1, 2
  19  }
  20 }
  21
  22 sub ret12b {
  23  if ($x) {
  24   return 1
  25  }
  26  return 1, 2
  27 }
  28
  29 sub ret12c {
  30  if (@a) {
  31   return 1, 2
  32  }
  33 }
  34
  35 sub ret1l { $x ? 1 : @_ }
  36
  37 sub ret1234 {
  38  if ($x) {
  39   return 1, 2
  40  } elsif ($h{foo}) {
  41   return 3, @a[4, 5];
  42  } elsif (@a) {
  43   return @h{qw<a b c>}, $y
  44  }
  45 }
  46
  47 sub retinif1 {
  48  if (return 1, 2) {
  49   return 1, 2, 3
  50  } else {
  51   return @_[0 .. 3]
  52  }
  53 }
  54
  55 sub retinif2 {
  56  if (do { return 2, 3 if $x }) {
  57   return 4, 5, 6;
  58  }
  59 }
  60
  61 my @tests = (
  62  [ \&ret12,                    { 1 => 0.5, 2 => 0.5 } ],
  63  [ \&ret12b,                   { 1 => 0.5, 2 => 0.5 } ],
  64  [ \&ret12c,                   { 1 => 0.5, 2 => 0.5 } ],
  65  [ sub { 1, ret12 },           { 2 => 0.5, 3 => 0.5 } ],
  66  [ sub { 1, do { ret12, 3 } }, { 3 => 0.5, 4 => 0.5 } ],
  67  [ sub { @_[ret12()] },        { 1 => 0.5, 2 => 0.5 } ],
  68
  69  [ sub { ret12, ret12 },    { 2 => 0.25, 3 => 0.5, 4 => 0.25 } ],
  70  [ sub { ret12, 0, ret12 }, { 3 => 0.25, 4 => 0.5, 5 => 0.25 } ],
  71  [ sub { ret12, @a },       { list => 1 } ],
  72  [ sub { %h, ret12 },       { list => 1 } ],
  73
  74  [ sub { if ($y) { ret12 } else { ret12 } }, { 1 => 0.5, 2 => 0.5 } ],
  75
  76  [ \&ret1l,                     { 1 => 0.5, list => 0.5 } ],
  77  [ sub { $_[0], ret1l },        { 2 => 0.5, list => 0.5 } ],
  78  [ sub { ret1l, ret1l, ret1l }, { 3 => 0.125, list => 0.875 } ],
  79
  80  [ \&ret1234, { 2 => 0.5, 3 => 0.25, 4 => 0.125, 1 => 0.125 } ],
  81
  82  [ \&retinif1, { 2 => 1 } ],
  83  [ \&retinif2, { 2 => 0.5, 3 => 0.25, 1 => 0.25 } ],
  84
  85  [ sub { $x || (3, 4) }, { 1 => 0.5, 2 => 0.5 } ],
  86  [ sub { $x or (3, 4) }, { 1 => 0.5, 2 => 0.5 } ],
  87  [ sub { $x &&  (3, 4) }, { 1 => 0.5, 2 => 0.5 } ],
  88  [ sub { $x and (3, 4) }, { 1 => 0.5, 2 => 0.5 } ],
  89  (([ eval 'sub { $x // (3, 4) }', { 1 => 0.5, 2 => 0.5 } ]) x ("$]" >= 5.010)),
  90 );
  91
  92 my $i = 1;
  93 for (@tests) {
  94  my $r = $sn->nary($_->[0]);
  95  my $exp = ref $_->[1] ? $_->[1] : { $_->[1] => 1 };
  96  is_deeply($r, $exp, 'branch test ' . $i);
  97  ++$i;
  98 }
  99