]> git.vpit.fr Git - perl/modules/Sub-Nary.git/commitdiff
One more test to exaust for cases. Remove debugging cruft
authorVincent Pit <vince@profvince.com>
Fri, 8 Aug 2008 21:30:58 +0000 (23:30 +0200)
committerVincent Pit <vince@profvince.com>
Fri, 8 Aug 2008 21:30:58 +0000 (23:30 +0200)
lib/Sub/Nary.pm
samples/cx.pl
t/20-return.t

index 52a3f8402e4c4783a0441da8ed35b24f4466ad9f..ef92fa178aab2f41bef787150aae2aec7b6ffca1 100644 (file)
@@ -9,8 +9,6 @@ use Carp qw/croak/;
 
 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.
@@ -26,8 +24,6 @@ BEGIN {
  $VERSION  = '0.02';
 }
 
-our $DEBUG = 0;
-
 =head1 SYNOPSIS
 
     use Sub::Nary;
@@ -243,7 +239,6 @@ sub inspect {
  my ($self, $op) = @_;
 
  my $n = name($op);
- diag "@ $n" if $DEBUG;
  return add($self->inspect_kids($op)), undef if $n eq 'return';
 
  my $meth = $self->can('pp_' . $n);
@@ -258,8 +253,6 @@ sub inspect {
  if (class($op) eq 'LOGOP' and not null $op->first) {
   my @res;
 
-  diag "? logop\n" if $DEBUG;
-
   my $op = $op->first;
   my ($r1, $l1) = $self->inspect($op);
   return $r1, $l1 if defined $r1 and zero $l1;
@@ -311,10 +304,8 @@ sub inspect_kids {
    $op = $op->first;
    redo;
   }
-  diag "> $n" if $DEBUG;
   my ($rc, $lc) = $self->inspect($op);
   $c = 1 - count $r;
-  diag Dumper [ $c, $r, \@l, $rc, $lc ] if $DEBUG;
   $r = add $r, scale $c, $rc if defined $rc;
   if (not defined $lc) {
    @l = ();
@@ -323,7 +314,6 @@ sub inspect_kids {
   push @l, scale $c, $lc;
  }
 
-# diag Dumper \@l if $DEBUG;
  my $l = scale +(1 - count $r), normalize combine @l;
 
  return $r, $l;
@@ -365,7 +355,6 @@ sub pp_entersub {
  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) {
@@ -480,8 +469,6 @@ sub pp_aassign {
 sub pp_leaveloop {
  my ($self, $op) = @_;
 
- diag "* leaveloop" if $DEBUG;
-
  $op = $op->first;
  my ($r1, $l1);
  my $for;
@@ -509,7 +496,6 @@ sub pp_leaveloop {
  my $r = (defined $r1) ? add $r1, scale +(1 - count $r1), $r2
                        : $r2;
  my $c = 1 - count $r;
- diag "& leaveloop $c" if $DEBUG;
  return $r, $c ? { 0 => $c } : undef;
 }
 
@@ -557,7 +543,6 @@ sub pp_grepwhile {
  my ($r1, $l1) = $self->inspect($op);
  return (add $r2, scale $c2, $r1), undef if defined $r1 and zero $l1
                                                         and not zero $l2;
- diag Dumper [ [ $r1, $l1 ], [ $r2, $l2 ] ] if $DEBUG;
  my $c1 = count $l1;
 
  $l2 = { $l2 => 1 } unless ref $l2;
@@ -582,7 +567,6 @@ sub pp_mapwhile {
  my ($r1, $l1) = $self->inspect($op);
  return (add $r2, scale $c2, $r1), undef if defined $r1 and zero $l1
                                                         and not zero $l2;
- diag Dumper [ [ $r1, $l1 ], [ $r2, $l2 ] ] if $DEBUG;
  my $c1 = count $l1;
 
  $l2 = { $l2 => 1 } unless ref $l2;
index 8717d395ea41154cf06f4d477138397d0cfdc975..fec95776d182467e8d12892d6db5414f58ad0747 100755 (executable)
@@ -7,7 +7,6 @@ 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);
 
index e17deda4511f4559f138d05fe38b32413b913521..d14a3a55c3ff4d741b758883f046aba4629ce612 100644 (file)
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 66;
+use Test::More tests => 67;
 
 use Sub::Nary;
 
@@ -64,6 +64,7 @@ my @tests = (
  [ sub { for (1, 2, 3) { } return 1, 2; },                               2 ],
  [ sub { for (do { return 1, 2, 3 }) { } return 1, 2; },                 3 ],
  [ sub { for (do { return 2, 3 if $x }) { } },      { 2 => 0.5, 0 => 0.5 } ],
+ [ sub { for (1, 2, 3) { return 1, 2 if $x } },                     'list' ],
  [ sub { for ($x, 1, $y) { return 1, 2 } },                              2 ],
  [ sub { for (@a) { return 1, do { $x } } },                             2 ],
  [ sub { for (keys %h) { return do { 1 }, do { return @a[0, 2] } } },    2 ],