t/10-flatten.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 27;
   7
   8 use Sub::Prototype::Util qw/flatten/;
   9
  10 eval { flatten '\@', undef };
  11 like($@, qr/^Got\s+undef/, 'flatten "\@", undef croaks');
  12 eval { flatten '\@', 1 };
  13 like($@, qr/^Got\s+a\s+plain\s+scalar/, 'flatten "\@", scalar croaks');
  14 eval { flatten '\@', { foo => 1 } };
  15 like($@, qr/^Unexpected\s+HASH\s+reference/, 'flatten "\@", hashref croaks');
  16 eval { flatten '\@', \(\1) };
  17 like($@, qr/^Unexpected\s+REF\s+reference/, 'flatten "\@", double ref croaks');
  18
  19 my $a = [ 1, 2, 3 ];
  20 my $b = [ [ 1, 2 ], 3, { 4 => 5 }, undef, \6 ];
  21 sub hlagh { return 'HLAGH' };
  22 my @tests = (
  23  [ undef,      'undef prototype',            $a, $a ],
  24  [ '',         'empty prototype',            $a, [ ] ],
  25  [ '$',        'truncating to 1',            $a, [ 1 ] ],
  26  [ '$$',       'truncating to 2',            $a, [ 1, 2 ] ],
  27  [ '$;$',      'truncating to 1+1',          $a, [ 1, 2 ] ],
  28  [ '@',        'globbing with @',            $a, $a ],
  29  [ '@@',       'globbing with @@',           $a, $a ],
  30  [ '%',        'globbing with %',            $a, $a ],
  31  [ '%%',       'globbing with %%',           $a, $a ],
  32  [ '@%',       'globbing with @%',           $a, $a ],
  33  [ '%@',       'globbing with %@',           $a, $a ],
  34  [ '\@',       'arrayref and truncate to 1', $b, [ 1, 2 ] ],
  35  [ '\@$$',     'arrayref and truncate to 3', $b, [ 1, 2, 3, { 4 => 5 } ] ],
  36  [ '$$\%',     'hashref and truncate to 3',  $b, [ [ 1, 2 ], 3, 4, 5 ] ],
  37  [ '$$\%',     'hashref and truncate to 3',  $b, [ [ 1, 2 ], 3, 4, 5 ] ],
  38  [ '\@$\%$\$', 'all usual references',       $b, [ 1, 2, 3, 4, 5, undef, 6 ] ],
  39  [ '\*$',      'globref', [ \*main::STDOUT, 1 ], [ '*main::STDOUT', 1 ] ],
  40  [ '\&$',      'coderef', [ \&main::hlagh,  1 ], [ 'HLAGH',   1 ] ],
  41  [ '\[$@%]',   'class got scalarref',    [ \1 ], [ 1 ] ],
  42  [ '\[$@%]',   'class got arrayref',  [ [ 1 ] ], [ 1 ] ],
  43  [ '\[$@%]',   'class got hashref', [ { 1,2 } ], [ 1, 2 ] ],
  44  [ '_',        '_ with argument',      [ 1, 2 ], [ ] ],
  45  [ '_',        '_ with no argument',        [ ], [ ] ]
  46 );
  47
  48 is_deeply( [ flatten($_->[0], @{$_->[2]}) ], $_->[3], $_->[1]) for @tests;