Complete rewrite. Make the inspect process return both the ret state and the last...

diff --git a/lib/Sub/Nary.pm b/lib/Sub/Nary.pm
index 058048249bb723f9a23481098addd389b342615e..aa2fc87359590e8ba275516f0f084291d8b90d4f 100644 (file)
--- a/lib/Sub/Nary.pm
+++ b/lib/Sub/Nary.pm
@@ -10,6 +10,8 @@ use List::Util qw/reduce sum/;
 
 use B qw/class ppname svref_2object OPf_KIDS/;
 
+use Test::More; use Data::Dumper;
+
 =head1 NAME
 
 Sub::Nary - Try to count how many elements a subroutine can return in list context.
@@ -25,6 +27,8 @@ BEGIN {
  $VERSION  = '0.02';
 }
 
+our $DEBUG = 0;
+
 =head1 SYNOPSIS
 
     use Sub::Nary;
@@ -60,7 +64,7 @@ The probability is computed as such :
 
 =over 4
 
-=item * All the returning points in the same subroutine (i.e. all the explicit C<return> and the last computed value) are considered equally possible.
+=item * When branching, each branch is considered equally possible.
 
 For example, the subroutine
 
@@ -84,7 +88,7 @@ As for
      }
     }
 
-it is considered to return C<1> (when the two tests fail, the last computed value is returned, which here is C<< $x > 0.9 >> evaluated in the scalar context of the test), C<2> or C<3> arguments each with probability C<1/3>.
+it is considered to return C<3> scalars with probability C<1/2>, C<2> with probability C<1/2 * 1/2 = 1/4> and C<1> (when the two tests fail, the last computed value is returned, which here is C<< $x > 0.9 >> evaluated in the scalar context of the test) with remaining probability C<1/4>.
 
 =item * The total probability law for a given returning point is the convolution product of the probabilities of its list elements.
 
@@ -165,14 +169,50 @@ sub nary {
  my $sub  = shift;
 
  $self->{cv} = [ ];
- return $self->enter(svref_2object($sub));
+ return ($self->enter(svref_2object($sub)))[1];
 }
 
 sub name ($) {
+ local $SIG{__DIE__} = \&Carp::confess;
  my $n = $_[0]->name;
  $n eq 'null' ? substr(ppname($_[0]->targ), 3) : $n
 }
 
+sub zero ($) {
+ my $r = $_[0];
+ return 1 unless defined $r;
+ return $r eq '0' unless ref $r;
+ return $r->{0} and 1 == scalar keys %$r;
+}
+
+sub list ($) {
+ my $r = $_[0];
+ return 0 unless defined $r;
+ return $r eq 'list' unless ref $r;
+ return $r->{list} and 1 == scalar keys %$r;
+}
+
+sub count ($) {
+ my $r = $_[0];
+ return 0 unless defined $r;
+ return 1 unless ref $r;
+ sum values %$r;
+}
+
+sub normalize ($) {
+ my $r = $_[0];
+ return unless defined $r;
+ return { 0 => 1 } unless keys %$r;
+ my $total = count $r;
+ return { map { $_ => $r->{$_} / $total } keys %$r };
+}
+
+sub scale {
+ my ($c, $r) = @_;
+ return unless defined $r;
+ return (ref $r) ? { map { $_ => $r->{$_} * $c } keys %$r } : { $r => $c };
+}
+
 sub combine {
  reduce {{
   my %res;
@@ -196,13 +236,13 @@ sub combine {
 
 sub power {
  my ($p, $n, $c) = @_;
- my $s = sum values %$p;
- return { 0 => $s * $c } unless $n;
+ return unless defined $p;
+ return { 0 => $c } unless $n;
  if ($n eq 'list') {
   my $z = delete $p->{0};
   return { 'list' => $c } unless $z;
   return { 0      => $c } if $z == 1;
-  return { 0 => $c * $z, list => $c * ($s - $z) };
+  return { 0 => $c * $z, list => $c * (1 - $z) };
  }
  my $r = combine map { { %$p } } 1 .. $n;
  $r->{$_} *= $c for keys %$r;
@@ -219,7 +259,7 @@ sub add {
 my %ops;
 
 $ops{$_} = 1      for scalops;
-$ops{$_} = 0      for qw/stub nextstate/;
+$ops{$_} = 0      for qw/stub nextstate pushmark iter unstack/;
 $ops{$_} = 1      for qw/padsv/;
 $ops{$_} = 'list' for qw/padav/;
 $ops{$_} = 'list' for qw/padhv rv2hv/;
@@ -243,106 +283,112 @@ $ops{$_} = { 0 => 0.5, 4 => 0.5 }  for qw/gsbyname gsbyport gservent/;
 sub enter {
  my ($self, $cv) = @_;
 
- return 'list' if class($cv) ne 'CV';
+ return undef, 'list' if class($cv) ne 'CV';
  my $op  = $cv->ROOT;
  my $tag = tag($op);
 
- return { %{$self->{cache}->{$tag}} } if exists $self->{cache}->{$tag};
+ return undef, { %{$self->{cache}->{$tag}} } if exists $self->{cache}->{$tag};
 
  # Anything can happen with recursion
  for (@{$self->{cv}}) {
-  return 'list' if $tag == tag($_->ROOT);
+  return undef, 'list' if $tag == tag($_->ROOT);
  }
 
  unshift @{$self->{cv}}, $cv;
- (my $r, undef) = $self->expect_any($op->first);
+ my $r = add $self->inspect($op->first);
  shift @{$self->{cv}};
 
- $r = { $r => 1} unless ref $r;
- my $total = sum values %$r;
- $r = { map { $_ => $r->{$_} / $total } keys %$r };
+ $r = { $r => 1 } unless ref $r;
  $self->{cache}->{$tag} = { %$r };
- return $r;
+ return undef, $r;
 }
 
-sub expect_return {
- my ($self, $op) = @_;
-
- return ($self->expect_kids($op))[0] => 1 if name($op) eq 'return';
-
- if ($op->flags & OPf_KIDS) {
-  for ($op = $op->first; not null $op; $op = $op->sibling) {
-   my ($p, $r) = $self->expect_return($op);
-   return $p => 1 if $r;
-  }
- }
-
- return 0;
-}
-
-sub expect_any {
+sub inspect {
  my ($self, $op) = @_;
 
  my $n = name($op);
- return ($self->expect_kids($op))[0] => 1 if $n eq 'return';
+ diag "@ $n" if $DEBUG;
+ return add($self->inspect_kids($op)), undef if $n eq 'return';
 
  my $meth = $self->can('pp_' . $n);
  return $self->$meth($op) if $meth;
 
  if (exists $ops{$n}) {
-  my $r = $ops{$n};
-  $r = { %$r } if ref $r;
-  return $r => 0;
+  my $l = $ops{$n};
+  $l = { %$l } if ref $l;
+  return undef, $l;
  }
 
  if (class($op) eq 'LOGOP' and not null $op->first) {
   my @res;
-  my ($p, $r);
 
-  my $op   = $op->first;
-  ($p, $r) = $self->expect_return($op);
-  return $p => 1 if $r;
+  diag "? logop\n" if $DEBUG;
+
+  my $op = $op->first;
+  my ($r1, $l1) = $self->inspect($op);
+  return $r1, $l1 if $r1 and zero $l1;
+  my $c = count $l1;
 
   $op = $op->sibling;
-  push @res, ($self->expect_any($op))[0];
+  my ($r2, $l2) = $self->inspect($op);
 
-  # If the logop has no else branch, it can also return the *scalar* result of
-  # the conditional
   $op = $op->sibling;
+  my ($r3, $l3);
   if (null $op) {
-   push @res, 1;
+   # If the logop has no else branch, it can also return the *scalar* result of
+   # the conditional
+   $l3 = { 1 => $c };
   } else {
-   push @res, ($self->expect_any($op))[0];
+   ($r3, $l3) = $self->inspect($op);
   }
 
-  return (add @res) => 0;
+  my $r = add $r1, scale $c / 2, add $r2, $r3;
+  my $l = scale $c / 2, add $l2, $l3;
+  return $r, $l
  }
 
- return $self->expect_kids($op);
+ return $self->inspect_kids($op);
 }
 
-sub expect_kids {
+sub inspect_kids {
  my ($self, $op) = @_;
 
- return 0 unless $op->flags & OPf_KIDS;
+ return undef, 0 unless $op->flags & OPf_KIDS;
+
+ $op = $op->first;
+ return undef, 0 if null $op;
+ if (name($op) eq 'pushmark') {
+  $op = $op->sibling;
+  return undef, 0 if null $op;
+ }
 
- my @res = (0);
- my ($p, $r);
- for ($op = $op->first; not null $op; $op = $op->sibling) {
+ my ($r, @l);
+ my $c = 1;
+ for (; not null $op; $op = $op->sibling) {
   my $n = name($op);
-  next if $n eq 'pushmark';
-  if ($n eq 'nextstate'
-      and not null(($op = $op->sibling)->sibling)) {
-   ($p, $r) = $self->expect_return($op);
-   return $p => 1 if $r;
-  } else {
-   ($p, $r) = $self->expect_any($op);
-   return $p => 1 if $r;
-   push @res, $p;
+  if ($n eq 'nextstate') {
+   @l  = ();
+   next;
   }
+  if ($n eq 'lineseq') {
+   @l  = ();
+   $op = $op->first;
+   redo;
+  }
+  diag "> $n ($c)" if $DEBUG;
+  my ($rc, $lc) = $self->inspect($op);
+  $r = add $r, scale $c, $rc if defined $rc;
+  if ($rc and not defined $lc) {
+   @l = ();
+   last;
+  }
+  push @l, scale $c, $lc;
+  $c *= count $lc if defined $lc;
  }
 
- return (combine @res) => 0;
+ my $l = combine @l;
+
+ return $r, $l;
 }
 
 # Stolen from B::Deparse
@@ -367,17 +413,28 @@ sub const_sv {
 }
 
 sub pp_entersub {
- my ($self, $op, $exp) = @_;
+ my ($self, $op) = @_;
 
- my $next = $op;
- while ($next->flags & OPf_KIDS) {
-  $next = $next->first;
+ $op = $op->first while $op->flags & OPf_KIDS;
+ return undef, 0 if null $op;
+ if (name($op) eq 'pushmark') {
+  $op = $op->sibling;
+  return undef, 0 if null $op;
  }
- while (not null $next) {
-  $op = $next;
-  my ($p, $r) = $self->expect_return($op, $exp);
-  return $p => 1 if $r;
-  $next = $op->sibling;
+
+ my $r;
+ my $c = 1;
+ for (; not null $op->sibling; $op = $op->sibling) {
+  my $n = name($op);
+  next if $n eq 'nextstate';
+  diag "* $n" if $DEBUG;
+  my ($rc, $lc) = $self->inspect($op);
+  $r = add $r, scale $c, $rc if defined $rc;
+  if (zero $lc) {
+   $c = 1 - count $r;
+   return $r, $c ? { 0 => $c } : undef
+  }
+  $c *= count $lc;
  }
 
  if (name($op) eq 'rv2cv') {
@@ -391,25 +448,26 @@ sub pp_entersub {
    }
    $n  = name($op)
   } while ($op->flags & OPf_KIDS and { map { $_ => 1 } qw/null leave/ }->{$n});
-  return 'list' unless { map { $_ => 1 } qw/gv refgen/ }->{$n};
+  return 'list', undef unless { map { $_ => 1 } qw/gv refgen/ }->{$n};
   local $self->{sub} = 1;
-  return $self->expect_any($op, $exp);
+  my ($rc, $lc) = $self->inspect($op);
+  return $r, scale $c, $lc;
  } else {
   # Method call ?
-  return 'list';
+  return $r, { 'list' => $c };
  }
 }
 
 sub pp_gv {
  my ($self, $op) = @_;
 
- return $self->{sub} ? $self->enter($self->gv_or_padgv($op)->CV) : 1
+ return $self->{sub} ? $self->enter($self->gv_or_padgv($op)->CV) : (undef, 1)
 }
 
 sub pp_anoncode {
  my ($self, $op) = @_;
 
- return $self->{sub} ? $self->enter($self->const_sv($op)) : 1
+ return $self->{sub} ? $self->enter($self->const_sv($op)) : (undef, 1)
 }
 
 sub pp_goto {
@@ -430,35 +488,43 @@ sub pp_goto {
   $n  = $nn;
  }
 
- return 'list';
+ return undef, 'list';
 }
 
 sub pp_const {
  my ($self, $op) = @_;
 
+ return undef, 0 unless $op->isa('B::SVOP');
+
  my $sv = $self->const_sv($op);
- my $c = class($sv);
+ my $n  = 1;
+ my $c  = class($sv);
  if ($c eq 'AV') {
-  return $sv->FILL + 1;
+  $n = $sv->FILL + 1
  } elsif ($c eq 'HV') {
-  return 2 * $sv->FILL;
+  $n = 2 * $sv->FILL
  }
 
- return 1;
+ return undef, $n
 }
 
-sub pp_aslice { $_[0]->expect_any($_[1]->first->sibling) }
+sub pp_aslice { $_[0]->inspect($_[1]->first->sibling) }
 
 sub pp_hslice;
 *pp_hslice = *pp_aslice{CODE};
 
-sub pp_lslice { $_[0]->expect_any($_[1]->first) }
+sub pp_lslice { $_[0]->inspect($_[1]->first) }
 
 sub pp_rv2av {
  my ($self, $op) = @_;
  $op = $op->first;
 
- return (name($op) eq 'const') ? $self->expect_any($op) : 'list';
+ my ($r, $l) = $self->inspect($op);
+ if (name($op) ne 'const') {
+  my $c = 1 - count $r;
+  $l = $c ? { list => $c } : 0;
+ }
+ return $r, $l; 
 }
 
 sub pp_aassign {
@@ -467,73 +533,109 @@ sub pp_aassign {
  $op = $op->first;
 
  # Can't assign to return
- my ($p, $r) = $self->expect_any($op->sibling);
- return $p => 0 if not exists $p->{list};
+ my $l = ($self->inspect($op->sibling))[1];
+ return undef, $l if not exists $l->{list};
 
- $self->expect_any($op);
+ $self->inspect($op);
 }
 
-sub pp_leaveloop { $_[0]->expect_return($_[1]->first->sibling) }
+sub pp_leaveloop {
+ my ($self, $op) = @_;
+
+ diag "* leaveloop" if $DEBUG;
+
+ $op = $op->first;
+ my ($r1, $l1);
+ if (name($op) eq 'enteriter') {
+  ($r1, $l1) = $self->inspect($op);
+  return $r1, $l1 if $r1 and zero $l1;
+ }
+
+ $op = $op->sibling;
+ my $r = (name($op->first) eq 'and') ? ($self->inspect($op->first->first->sibling))[0]
+                                     : ($self->inspect($op))[0];
+ my $c = 1 - count $r;
+ diag "& leaveloop" if $DEBUG;
+ return $r, $c ? { 0 => $c } : undef;
+}
 
 sub pp_flip {
  my ($self, $op) = @_;
 
  $op = $op->first;
- return 'list' if name($op) ne 'range';
+ return $self->inspect($op) if name($op) ne 'range';
 
+ my ($r, $l);
  my $begin = $op->first;
  if (name($begin) eq 'const') {
   my $end = $begin->sibling;
   if (name($end) eq 'const') {
-   $begin  = $self->const_sv($begin);
-   $end    = $self->const_sv($end);
-   no warnings 'numeric';
-   return int(${$end->object_2svref}) - int(${$begin->object_2svref}) + 1;
+   $begin = $self->const_sv($begin);
+   $end   = $self->const_sv($end);
+   {
+    no warnings 'numeric';
+    $begin = int ${$begin->object_2svref};
+    $end   = int ${$end->object_2svref};
+   }
+   return undef, $end - $begin + 1;
   } else {
-   my ($p, $r) = $self->expect_return($end);
-   return $p => 1 if $r;
+   ($r, $l) = $self->inspect($end);
   }
  } else {
-  my ($p, $r) = $self->expect_return($begin);
-  return $p => 1 if $r;
+  ($r, $l) = $self->inspect($begin);
  }
 
- return 'list'
+ my $c = 1 - count $r;
+ return $r, ($l && $c) ? { 'list' => $c } : undef
 }
 
 sub pp_grepwhile {
  my ($self, $op) = @_;
 
  $op = $op->first;
- return 'list' if name($op) ne 'grepstart';
-
+ return $self->inspect($op) if name($op) ne 'grepstart';
  $op = $op->first->sibling;
- my ($p, $r) = $self->expect_any($op);
- return $p => 1 if $r;
-
- $op = $op->sibling;
- ($p, $r) = $self->expect_any($op);
- return $p => 1 if $r;
 
- return 'list';
+ my ($r2, $l2) = $self->inspect($op->sibling);
+ return $r2, $l2 if $r2 and zero $l2;
+ diag Dumper [ $r2, $l2 ] if $DEBUG;
+ my $c = count $l2; # First one to happen
+
+ my ($r1, $l1) = $self->inspect($op);
+ diag Dumper [ $r1, $l1 ] if $DEBUG;
+ return (add $r2, scale $c, $r1), undef if $r1 and zero $l1 and not zero $l2;
+ return { 'list' => 1 }, undef if list $l2;
+
+ $l2 = { $l2 => 1 } unless ref $l2;
+ my $r = add $r2, scale $c,
+                   normalize
+                    add map { power $r1, $_, $l2->{$_} } keys %$l2;
+ $c = 1 - count $r;
+ return $r, $c ? { ((zero $l2) ? 0 : 'list') => $c } : undef;
 }
 
 sub pp_mapwhile {
  my ($self, $op) = @_;
 
  $op = $op->first;
- return 'list' if name($op) ne 'mapstart';
-
+ return $self->inspect($op) if name($op) ne 'mapstart';
  $op = $op->first->sibling;
- my ($p1, $r) = $self->expect_any($op);
- return $p1 => 1 if $r;
-
- $op = $op->sibling;
- (my $p2, $r) = $self->expect_any($op);
- return $p2 => 1 if $r;
- $p2 = { $p2 => 1 } unless ref $p2;
 
- return add map { power $p1, $_, $p2->{$_} } keys %$p2;
+ my ($r2, $l2) = $self->inspect($op->sibling);
+ return $r2, $l2 if $r2 and zero $l2;
+ my $c = count $l2; # First one to happen
+
+ my ($r1, $l1) = $self->inspect($op);
+ return (add $r2, scale $c, $r1), undef if $r1 and zero $l1 and not zero $l2;
+ diag Dumper [ [ $r1, $l1 ], [ $r2, $l2 ] ] if $DEBUG;
+
+ $l2 = { $l2 => 1 } unless ref $l2;
+ my $r = add $r2, scale $c,
+                   normalize
+                    add map { power $r1, $_, $l2->{$_} } keys %$l2;
+ $c = 1 - count $r;
+ my $l = scale $c, normalize add map { power $l1, $_, $l2->{$_} } keys %$l2;
+ return $r, $l;
 }
 
 =head1 EXPORT

diff --git a/samples/cx.pl b/samples/cx.pl
index 0b51a13399eb7c51e3ae63e22693cdf34d2fd44c..8717d395ea41154cf06f4d477138397d0cfdc975 100755 (executable)
--- a/samples/cx.pl
+++ b/samples/cx.pl
@@ -7,6 +7,7 @@ use lib qw{blib/lib blib/arch};
 use B::Deparse;
 use B::Concise;
 use Sub::Nary;
+$Sub::Nary::DEBUG = 1;
 
 my ($x, $y, @z, %h);
 
@@ -42,7 +43,7 @@ sub wut2 {
  } elsif ($y) {
   sub { qr/wat/ }, %h;
  } elsif (@z) {
-  return [ ] 
+  return [ ];
  }
 }
 

diff --git a/t/20-return.t b/t/20-return.t
index ee42a98054af4bd4980381778a4418b35bc02dc8..48d3a54a1cbdbe9a649c5cc2186cbbc0b1baf05f 100644 (file)
--- a/t/20-return.t
+++ b/t/20-return.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 62;
+use Test::More tests => 72;
 
 use Sub::Nary;
 
@@ -11,6 +11,8 @@ my $sn = Sub::Nary->new();
 
 my ($x, $y, @a, %h);
 
+my $exp_2 = { 1 => 0.5, 2 => 0.5 };
+
 my @tests = (
  [ sub { return },               0 ],
  [ sub { return () },            0 ],
@@ -81,11 +83,25 @@ my @tests = (
 
  [ sub { eval 'return 1, 2' }, 'list' ],
 
- [ sub { grep { return 2, 4 } 5 .. 10 },                2 ],
- [ sub { grep { $_ > 1 } do { return 2, 4; 5 .. 10 } }, 2 ],
-
- [ sub { map { return 2, 4 } 5 .. 10 },                2 ],
- [ sub { map { $_ + 1 } do { return 2, 4; 5 .. 10 } }, 2 ],
+ [ sub { grep { return 2, 4 } 5 .. 10 },                  2 ],
+ [ sub { grep { $_ > 1 } do { return 2, 4; 5 .. 10 } },   2 ],
+ [ sub { grep { return 2, 4 } () },                       0 ],
+ [ sub { grep { return $_ ? 2 : (3, 4) } 7 .. 8 },        $exp_2 ],
+ [ sub { grep { $_ > 1 } do { return $x ? 7 : (8, 9) } }, $exp_2 ],
+ [ sub { grep { return $_ ? 2 : (3, 4) } do { return 3 .. 5 if $x; } },
+                                           { 3 => 0.5, 1 => 0.25, 2 => 0.25 } ],
+ [ sub { grep { return $_ ? 2 : (3, 4) } do { return 3 .. 5 if $x; () } },
+                                                       { 3 => 0.5, 0 => 0.5 } ],
+
+ [ sub { map { return 2, 4 } 5 .. 10 },                  2 ],
+ [ sub { map { $_ + 1 } do { return 2, 4; 5 .. 10 } },   2 ],
+ [ sub { map { return 2, 4 } () },                       0 ],
+ [ sub { map { return $_ ? 2 : (3, 4) } 7 .. 8 },        $exp_2 ],
+ [ sub { map { $_ > 1 } do { return $x ? 7 : (8, 9) } }, $exp_2 ],
+ [ sub { map { return $_ ? 2 : (3, 4) } do { return 3 .. 5 if $x; } },
+                                           { 3 => 0.5, 1 => 0.25, 2 => 0.25 } ],
+ [ sub { map { return $_ ? 2 : (3, 4) } do { return 3 .. 5 if $x; () } },
+                                                       { 3 => 0.5, 0 => 0.5 } ],
 );
 
 my $i = 1;

diff --git a/t/22-call.t b/t/22-call.t
index de288a665a83f28f16934f8d18731b5c0a5d2c6d..6aa786333a1bebd54980c6a27c63267796510e74 100644 (file)
--- a/t/22-call.t
+++ b/t/22-call.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 41;
+use Test::More tests => 42;
 
 use Sub::Nary;
 
@@ -24,6 +24,8 @@ sub rec1 { rec2(); }
 sub rec2 { rec1(); }
 
 my @tests = (
+ [ sub { hlaghlaghlagh() }, 'list' ],
+
  [ sub { zero }, 0 ],
  [ sub { one  }, 1 ],
  [ sub { two  }, 2 ],

diff --git a/t/23-branch.t b/t/23-branch.t
index 8bffe50fdbbf93f569681ec1c1b8a21ce2dccf66..8aced0dca51e33f26e27fb8a9d98b5da2fd8735e 100644 (file)
--- a/t/23-branch.t
+++ b/t/23-branch.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 14;
+use Test::More tests => 16;
 
 use Sub::Nary;
 
@@ -19,6 +19,19 @@ sub ret12 {
  }
 }
 
+sub ret12b {
+ if ($x) {
+  return 1
+ }
+ return 1, 2
+}
+
+sub ret12c {
+ if (@a) {
+  return 1, 2
+ }
+}
+
 sub ret1l { $x ? 1 : @_ }
 
 sub ret1234 {
@@ -41,6 +54,8 @@ sub retinif {
 
 my @tests = (
  [ \&ret12,                    { 1 => 0.5, 2 => 0.5 } ],
+ [ \&ret12b,                   { 1 => 0.5, 2 => 0.5 } ],
+ [ \&ret12c,                   { 1 => 0.5, 2 => 0.5 } ],
  [ sub { 1, ret12 },           { 2 => 0.5, 3 => 0.5 } ],
  [ sub { 1, do { ret12, 3 } }, { 3 => 0.5, 4 => 0.5 } ],
  [ sub { @_[ret12()] },        { 1 => 0.5, 2 => 0.5 } ],
@@ -56,7 +71,7 @@ my @tests = (
  [ sub { $_[0], ret1l },        { 2 => 0.5, list => 0.5 } ],
  [ sub { ret1l, ret1l, ret1l }, { 3 => 0.125, list => 0.875 } ],
 
- [ \&ret1234, { map { $_ => 0.25 } 1 .. 4 } ],
+ [ \&ret1234, { 2 => 0.5, 3 => 0.25, 4 => 0.125, 1 => 0.125 } ],
 
  [ \&retinif, { 2 => 1 } ],
 );

diff --git a/t/24-ops.t b/t/24-ops.t
index 506b55eb0b7ee0ab34eba418db55b6d4ba00d276..9b7f97021740213766b1828f7a92b5d9aecde2ed 100644 (file)
--- a/t/24-ops.t
+++ b/t/24-ops.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 47;
+use Test::More tests => 48;
 
 use Sub::Nary;
 
@@ -36,8 +36,8 @@ sub onetwothree {
 # { 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 };
+# { 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
+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 };
 
 my $b3 = 0.5 ** 3;
 my $exp_23 = { 3 => $b3, 4 => 3 * $b3, 5 => 3 * $b3, 6 => $b3 };
@@ -104,7 +104,7 @@ my @tests = (
  [ sub { endprotoent }, 1 ],
  [ sub { endservent },  1 ],
 
- [ sub { <*.*> }, { list => 1 / 3, 1 => 2 / 3 } ],
+ [ sub { <*.*> }, { list => 0.5, 1 => 0.5 } ],
 );
 
 my $i = 1;

diff --git a/t/92-pod-coverage.t b/t/92-pod-coverage.t
index 923a391b5a5a8321d3780380d3087f9e4730d6fb..6bc94f30b6387e2182dca6a8f09a4e4730f2f132 100644 (file)
--- a/t/92-pod-coverage.t
+++ b/t/92-pod-coverage.t
@@ -15,4 +15,4 @@ my $min_pc = 0.18;
 eval "use Pod::Coverage $min_pc";
 plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage" if $@;
 
-all_pod_coverage_ok({ also_private => [ qr/^pp_/, qr/^expect_/, qw/add combine power const_sv enter gv_or_padgv name null padval scalops tag/ ] });
+all_pod_coverage_ok({ also_private => [ qr/^pp_/, qr/^inspect/, qw/add combine power normalize scale count const_sv enter gv_or_padgv name null zero list padval scalops tag/ ] });