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 sub exception {
  11  my ($msg) = @_;
  12  $msg =~ s/\s+/\\s+/g;
  13  return qr/^$msg.*?at\s+\Q$0\E\s+line\s+\d+/;
  14 }
  15
  16 eval { flatten '$' };
  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';
  28
  29 my $a = [ 1, 2, 3 ];
  30 my $b = [ [ 1, 2 ], 3, { 4 => 5 }, undef, \6 ];
  31 sub hlagh { return 'HLAGH' };
  32 my @tests = (
  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 ] ],
  55 );
  56
  57 is_deeply( [ flatten($_->[0], @{$_->[2]}) ], $_->[3], $_->[1]) for @tests;