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.
$VERSION = '0.02';
}
-our $DEBUG = 0;
-
=head1 SYNOPSIS
use Sub::Nary;
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);
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;
$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 = ();
push @l, scale $c, $lc;
}
-# diag Dumper \@l if $DEBUG;
my $l = scale +(1 - count $r), normalize combine @l;
return $r, $l;
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) {
sub pp_leaveloop {
my ($self, $op) = @_;
- diag "* leaveloop" if $DEBUG;
-
$op = $op->first;
my ($r1, $l1);
my $for;
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;
}
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;
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;
use strict;
use warnings;
-use Test::More tests => 66;
+use Test::More tests => 67;
use Sub::Nary;
[ 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 ],