From: Vincent Pit <vince@profvince.com>
Date: Thu, 4 Jun 2009 22:15:33 +0000 (+0200)
Subject: Make flatten() die if not enough arugments were provided to match the given prototype
X-Git-Tag: v0.09~8
X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FSub-Prototype-Util.git;a=commitdiff_plain;h=f5bb214c4c842e14fb5e95a77a6888ab1ae81005

Make flatten() die if not enough arugments were provided to match the given prototype

Also consider the '_' prototype like '$', as there's no way to know if the argument was originally provided or not.
---

diff --git a/lib/Sub/Prototype/Util.pm b/lib/Sub/Prototype/Util.pm
index 20525ec..316d079 100644
--- a/lib/Sub/Prototype/Util.pm
+++ b/lib/Sub/Prototype/Util.pm
@@ -93,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;
   }
  }
diff --git a/t/10-flatten.t b/t/10-flatten.t
index 414cfcf..a2b9d6d 100644
--- a/t/10-flatten.t
+++ b/t/10-flatten.t
@@ -7,14 +7,24 @@ use Test::More tests => 27;
 
 use Sub::Prototype::Util qw/flatten/;
 
+sub exception {
+ my ($msg) = @_;
+ $msg =~ s/\s+/\\s+/g;
+ return qr/^$msg.*?at\s+\Q$0\E\s+line\s+\d+/;
+}
+
+eval { flatten '$' };
+like $@, exception('Not enough arguments to match this prototype'),
+                                                          'flatten("$") croaks';
 eval { flatten '\@', undef };
-like($@, qr/^Got\s+undef/, 'flatten "\@", undef croaks');
+like $@, exception('Got undef'), 'flatten "\@", undef croaks';
 eval { flatten '\@', 1 };
-like($@, qr/^Got\s+a\s+plain\s+scalar/, 'flatten "\@", scalar croaks');
+like $@, exception('Got a plain scalar'), 'flatten "\@", scalar croaks';
 eval { flatten '\@', { foo => 1 } };
-like($@, qr/^Unexpected\s+HASH\s+reference/, 'flatten "\@", hashref croaks');
+like $@, exception('Unexpected HASH reference'), 'flatten "\@", hashref croaks';
 eval { flatten '\@', \(\1) };
-like($@, qr/^Unexpected\s+REF\s+reference/, 'flatten "\@", double ref croaks');
+like $@, exception('Unexpected REF reference'),
+                                              'flatten "\@", double ref croaks';
 
 my $a = [ 1, 2, 3 ];
 my $b = [ [ 1, 2 ], 3, { 4 => 5 }, undef, \6 ];
@@ -41,8 +51,7 @@ my @tests = (
  [ '\[$@%]',   'class got scalarref',    [ \1 ], [ 1 ] ],
  [ '\[$@%]',   'class got arrayref',  [ [ 1 ] ], [ 1 ] ],
  [ '\[$@%]',   'class got hashref', [ { 1,2 } ], [ 1, 2 ] ],
- [ '_',        '_ with argument',      [ 1, 2 ], [ ] ],
- [ '_',        '_ with no argument',        [ ], [ ] ]
+ [ '_',        '_ with argument',      [ 1, 2 ], [ 1 ] ],
 );
 
 is_deeply( [ flatten($_->[0], @{$_->[2]}) ], $_->[3], $_->[1]) for @tests;