From: Vincent Pit <vince@profvince.com>
Date: Sun, 29 Jun 2008 15:52:09 +0000 (+0200)
Subject: Importing Sub-Prototype-Util-0.04.tar.gz
X-Git-Tag: v0.04^0
X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FSub-Prototype-Util.git;a=commitdiff_plain;h=28776527078c17a920f14823ef039503f08dc4d7

Importing Sub-Prototype-Util-0.04.tar.gz
---

diff --git a/Changes b/Changes
index ecf455a..cd90ae3 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,11 @@
 Revision history for Sub-Prototype-Util
 
+0.04    2008-04-09 13:25 UTC
+        + Fix : recall() should pass by reference as much as possible, or we
+                won't be able to apply it to functions that modify their
+                arguments (e.g. open()).
+        + Fix : our really doesn't exist in 5.005.
+
 0.03    2008-04-06 22:20 UTC
         + Fix : our doesn't exist in 5.005 (sigh).
         + Fix : '_' prototype should use the current argument when it's
diff --git a/META.yml b/META.yml
index 4014ea5..7300b25 100644
--- a/META.yml
+++ b/META.yml
@@ -1,6 +1,6 @@
 --- #YAML:1.0
 name:                Sub-Prototype-Util
-version:             0.03
+version:             0.04
 abstract:            Prototype-related utility routines.
 license:             perl
 author:              
diff --git a/README b/README
index 2865eb1..2971b31 100644
--- a/README
+++ b/README
@@ -2,7 +2,7 @@ NAME
     Sub::Prototype::Util - Prototype-related utility routines.
 
 VERSION
-    Version 0.03
+    Version 0.04
 
 SYNOPSIS
         use Sub::Prototype::Util qw/flatten recall/;
diff --git a/lib/Sub/Prototype/Util.pm b/lib/Sub/Prototype/Util.pm
index 2e2a504..5c0c04e 100644
--- a/lib/Sub/Prototype/Util.pm
+++ b/lib/Sub/Prototype/Util.pm
@@ -12,13 +12,13 @@ Sub::Prototype::Util - Prototype-related utility routines.
 
 =head1 VERSION
 
-Version 0.03
+Version 0.04
 
 =cut
 
 use vars qw/$VERSION/;
 
-$VERSION = '0.03';
+$VERSION = '0.04';
 
 =head1 SYNOPSIS
 
@@ -101,33 +101,35 @@ will call C<push @$a, 1, 2, 3> and so fill the arrayref C<$a> with C<1, 2, 3>. T
 =cut
 
 sub recall {
- my ($name, @a) = @_;
+ my $name = shift;
  croak 'Wrong subroutine name' unless $name;
  $name =~ s/^\s+//;
  $name =~ s/[\s\$\@\%\*\&;].*//;
  my $proto = prototype $name;
  my @args;
+ my @cr;
  if (defined $proto) {
   my $i = 0;
   while ($proto =~ /(\\?)(\[[^\]]+\]|[^\];])/g) {
    my $p = $2;
    if ($1) {
-    my $r = _check_ref $a[$i], $p;
-    push @args, join '', $sigils{$r}, '{$a[', $i, ']}';
+    my $r = _check_ref $_[$i], $p;
+    push @args, join '', $sigils{$r}, '{$_[', $i, ']}';
    } elsif ($p =~ /[\@\%]/) {
-    push @args, join '', '@a[', $i, '..', (@a - 1), ']';
+    push @args, join '', '@_[', $i, '..', (@_ - 1), ']';
     last;
    } elsif ($p =~ /\&/) {
-    push @args, 'sub{&{$a[' . $i . ']}}';
-   } elsif ($p eq '_' && $i >= @a) {
+    push @cr, $_[$i];
+    push @args, 'sub{&{$cr[' . $#cr . ']}}';
+   } elsif ($p eq '_' && $i >= @_) {
     push @args, '$_';
    } else {
-    push @args, '$a[' . $i . ']';
+    push @args, '$_[' . $i . ']';
    }
    ++$i; 
   }
  } else {
-  @args = map '$a[' . $_ . ']', 0 .. @a - 1;
+  @args = map '$_[' . $_ . ']', 0 .. @_ - 1;
  }
  my @ret = eval $name . '(' . join(',', @args) . ');';
  croak $@ if $@;
@@ -142,11 +144,13 @@ The functions L</flatten> and L</recall> are only exported on request, either by
 
 use base qw/Exporter/;
 
-our @EXPORT         = ();
-our %EXPORT_TAGS    = (
+use vars qw/@EXPORT @EXPORT_OK %EXPORT_TAGS/;
+
+@EXPORT             = ();
+%EXPORT_TAGS        = (
  'funcs' =>  [ qw/flatten recall/ ]
 );
-our @EXPORT_OK      = map { @$_ } values %EXPORT_TAGS;
+@EXPORT_OK          = map { @$_ } values %EXPORT_TAGS;
 $EXPORT_TAGS{'all'} = [ @EXPORT_OK ];
 
 =head1 DEPENDENCIES
diff --git a/t/11-recall.t b/t/11-recall.t
index 4925946..0c48dbb 100644
--- a/t/11-recall.t
+++ b/t/11-recall.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 3 + 12 + (($^V ge v5.10.0) ? 4 : 0);
+use Test::More tests => 3 + 14 + (($^V ge v5.10.0) ? 4 : 0);
 
 use Scalar::Util qw/set_prototype/;
 use Sub::Prototype::Util qw/recall/;
@@ -16,11 +16,14 @@ eval { recall 'hlagh' };
 like($@, qr/^Undefined\s+subroutine/, 'recall <unknown> croaks');
 
 sub noproto { $_[1], $_[0] }
-sub mytrunc ($;$) { $_[1], $_[0] };
-sub mygrep1 (&@) { grep { $_[0]->() } @_[1 .. $#_] };
-sub mygrep2 (\&@) { grep { $_[0]->() } @_[1 .. $#_] };
+sub mytrunc ($;$) { $_[1], $_[0] }
+sub mygrep1 (&@) { grep { $_[0]->() } @_[1 .. $#_] }
+sub mygrep2 (\&@) { grep { $_[0]->() } @_[1 .. $#_] }
+sub modify ($) { my $old = $_[0]; $_[0] = 5; $old }
+
 my $t = [ 1, 2, 3, 4 ];
 my $g = [ sub { $_ > 2 }, 1 .. 5 ];
+
 my @tests = (
  [ 'main::noproto', 'no prototype', $t, $t, [ 2, 1 ] ],
  [ 'CORE::push', 'push', [ [ 1, 2 ], 3, 5 ], [ [ 1, 2, 3, 5 ], 3, 5 ], [ 4 ] ],
@@ -28,7 +31,9 @@ my @tests = (
  [ 'main::mytrunc', 'truncate 2', $t, $t, [ 2, 1 ] ],
  [ 'main::mygrep1', 'grep1', $g, $g, [ 3 .. 5 ] ],
  [ 'main::mygrep2', 'grep2', $g, $g, [ 3 .. 5 ] ],
+ [ 'main::modify', 'modify arguments', [ 1 ], [ 5 ], [ 1 ] ],
 );
+
 sub myit { push @{$_[0]->[2]}, 3; return 4 };
 if ($^V ge v5.10.0) {
  set_prototype \&myit, '_';