Revision history for Sub-Prototype-Util
+0.08 2008-05-02 15:25 UTC
+ + Fix : "{ $func => undef }" (resp. "=> ''") should enforce no prototype
+ (resp. enforce an empty prototype).
+
0.07 2008-04-21 09:00 UTC
+ Add : Forward eval() errors when compiling in wrap().
+ Add : Talk about wrap() in the synopsis and samples/try.pl.
=head1 VERSION
-Version 0.07
+Version 0.08
=cut
use vars qw/$VERSION/;
-$VERSION = '0.07';
+$VERSION = '0.08';
=head1 SYNOPSIS
croak 'No subroutine specified' unless $name;
my $proto;
my $r = ref $name;
- if ($r eq 'HASH') {
+ if (!$r) {
+ $proto = prototype $name;
+ } elsif ($r eq 'HASH') {
croak 'Forced prototype hash reference must contain exactly one key/value pair' unless keys %$name == 1;
($name, $proto) = %$name;
- } elsif (length $r) {
+ } else {
croak 'Unhandled ' . $r . ' reference as first argument';
}
$name =~ s/^\s+//;
$name =~ s/[\s\$\@\%\*\&;].*//;
- $proto = prototype $name unless $proto;
return $name, $proto;
}
use strict;
use warnings;
-use Test::More tests => 7 + 18 + (($^V ge v5.10.0) ? 4 : 0);
+use Test::More tests => 7 + 20 + (($^V ge v5.10.0) ? 4 : 0);
use Scalar::Util qw/set_prototype/;
use Sub::Prototype::Util qw/recall/;
my @tests = (
[ 'main::noproto', 'no prototype', $t, $t, [ 2, 1 ] ],
- [ { 'CORE::push' => undef }, 'push', [ [ 1, 2 ], 3, 5 ], [ [ 1, 2, 3, 5 ], 3, 5 ], [ 4 ] ],
+ [ { 'main::noproto' => undef }, 'no prototype forced', $t, $t, [ 2, 1 ] ],
+ [ 'CORE::push', 'push', [ [ 1, 2 ], 3, 5 ], [ [ 1, 2, 3, 5 ], 3, 5 ], [ 4 ] ],
[ { 'CORE::push' => '\@$' }, 'push just one', [ [ 1, 2 ], 3, 5 ], [ [ 1, 2, 3 ], 3, 5 ], [ 3 ] ],
[ { 'CORE::map' => '\&@' }, 'map', $m, $m, [ 11 .. 15 ] ],
[ 'main::mytrunc', 'truncate 1', [ 1 ], [ 1 ], [ undef, 1 ] ],