6 use Test::More tests => 27;
8 use Sub::Prototype::Util qw<flatten>;
13 return qr/^$msg.*?at\s+\Q$0\E\s+line\s+\d+/;
17 like $@, exception('Not enough arguments to match this prototype'),
18 'flatten("$") croaks';
19 eval { flatten '\@', undef };
20 like $@, exception('Got undef'), 'flatten "\@", undef croaks';
21 eval { flatten '\@', 1 };
22 like $@, exception('Got a plain scalar'), 'flatten "\@", scalar croaks';
23 eval { flatten '\@', { foo => 1 } };
24 like $@, exception('Unexpected HASH reference'), 'flatten "\@", hashref croaks';
25 eval { flatten '\@', \(\1) };
26 like $@, exception('Unexpected REF reference'),
27 'flatten "\@", double ref croaks';
30 my $b = [ [ 1, 2 ], 3, { 4 => 5 }, undef, \6 ];
31 sub hlagh { return 'HLAGH' };
33 [ undef, 'undef prototype', $a, $a ],
34 [ '', 'empty prototype', $a, [ ] ],
35 [ '$', 'truncating to 1', $a, [ 1 ] ],
36 [ '$$', 'truncating to 2', $a, [ 1, 2 ] ],
37 [ '$;$', 'truncating to 1+1', $a, [ 1, 2 ] ],
38 [ '@', 'globbing with @', $a, $a ],
39 [ '@@', 'globbing with @@', $a, $a ],
40 [ '%', 'globbing with %', $a, $a ],
41 [ '%%', 'globbing with %%', $a, $a ],
42 [ '@%', 'globbing with @%', $a, $a ],
43 [ '%@', 'globbing with %@', $a, $a ],
44 [ '\@', 'arrayref and truncate to 1', $b, [ 1, 2 ] ],
45 [ '\@$$', 'arrayref and truncate to 3', $b, [ 1, 2, 3, { 4 => 5 } ] ],
46 [ '$$\%', 'hashref and truncate to 3', $b, [ [ 1, 2 ], 3, 4, 5 ] ],
47 [ '$$\%', 'hashref and truncate to 3', $b, [ [ 1, 2 ], 3, 4, 5 ] ],
48 [ '\@$\%$\$', 'all usual references', $b, [ 1, 2, 3, 4, 5, undef, 6 ] ],
49 [ '\*$', 'globref', [ \*main::STDOUT, 1 ], [ '*main::STDOUT', 1 ] ],
50 [ '\&$', 'coderef', [ \&main::hlagh, 1 ], [ 'HLAGH', 1 ] ],
51 [ '\[$@%]', 'class got scalarref', [ \1 ], [ 1 ] ],
52 [ '\[$@%]', 'class got arrayref', [ [ 1 ] ], [ 1 ] ],
53 [ '\[$@%]', 'class got hashref', [ { 1,2 } ], [ 1, 2 ] ],
54 [ '_', '_ with argument', [ 1, 2 ], [ 1 ] ],
57 is_deeply( [ flatten($_->[0], @{$_->[2]}) ], $_->[3], $_->[1]) for @tests;