X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FSub%2FPrototype%2FUtil.pm;h=316d079bbe85590ba6c35996ae25afb76bc54db5;hb=f5bb214c4c842e14fb5e95a77a6888ab1ae81005;hp=d549a1cc992e8ea86ceac04a35f89d11a7207098;hpb=06a00e8349c4f0c7b7388af0dbfcd562721e8d43;p=perl%2Fmodules%2FSub-Prototype-Util.git

diff --git a/lib/Sub/Prototype/Util.pm b/lib/Sub/Prototype/Util.pm
index d549a1c..316d079 100644
--- a/lib/Sub/Prototype/Util.pm
+++ b/lib/Sub/Prototype/Util.pm
@@ -57,6 +57,12 @@ sub _check_ref {
  return $r;
 }
 
+sub _clean_msg {
+ my ($msg) = @_;
+ $msg =~ s/(?:\s+called)?\s+at\s+.*$//s;
+ return $msg;
+}
+
 =head2 C<flatten $proto, @args>
 
 Flattens the array C<@args> according to the prototype C<$proto>. When C<@args> is what C<@_> is after calling a subroutine with prototype C<$proto>, C<flatten> returns the list of what C<@_> would have been if there were no prototype.
@@ -87,9 +93,8 @@ sub flatten {
   } elsif ($p =~ /[\@\%]/) {
    push @args, @_;
    last;
-  } elsif ($p eq '_') {
-   shift; # without prototype, this argument wouldn't have been passed
   } else {
+   croak 'Not enough arguments to match this prototype' unless @_;
    push @args, shift;
   }
  }
@@ -223,7 +228,7 @@ sub wrap {
  $call = 'sub ' . $call if $opts{sub};
  if ($opts{compile}) {
   $call = eval $call;
-  croak $@ if $@;
+  croak _clean_msg $@ if $@;
  }
  return $call;
 }
@@ -242,7 +247,7 @@ If you plan to recall several times, consider using L</wrap> instead.
 
 sub recall {
  my $wrap = eval { wrap shift };
- croak $@ if $@;
+ croak _clean_msg $@ if $@;
  return $wrap->(@_);
 }