]> git.vpit.fr Git - perl/modules/Sub-Nary.git/blob - t/23-branch.t
Fix a bug the handling of if (do { return if ; }) { ... }
[perl/modules/Sub-Nary.git] / t / 23-branch.t
1 #!perl -T
2
3 use strict;
4 use warnings;
5
6 use Test::More tests => 17;
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
86 my $i = 1;
87 for (@tests) {
88  my $r = $sn->nary($_->[0]);
89  my $exp = ref $_->[1] ? $_->[1] : { $_->[1] => 1 };
90  is_deeply($r, $exp, 'branch test ' . $i);
91  ++$i;
92 }
93