t/foreign/MooseX-Method-Signatures/list.t

   1 #!perl
   2 use strict;
   3 use warnings FATAL => 'all';
   4 use Test::More
   5     eval { require Moose }
   6     ? (tests => 25)
   7     : (skip_all => "Moose required for testing types")
   8 ;
   9 use Test::Fatal;
  10 use Function::Parameters qw(:strict);
  11
  12 my $o = bless {} => 'Foo';
  13
  14 {
  15     my %meths = (
  16         rest_list => method ($foo, $bar, @rest) {
  17             return join q{,}, @rest;
  18         },
  19         rest_named => method ($foo, $bar, %rest) {
  20             return join q{,}, map { $_ => $rest{$_} } sort keys %rest;
  21         },
  22     );
  23
  24     for my $meth_name (keys %meths) {
  25         my $meth = $meths{$meth_name};
  26         like(exception { $o->$meth() }, qr/Not enough arguments/, "$meth_name dies without args");
  27         like(exception { $o->$meth('foo') }, qr/Not enough arguments/, "$meth_name dies with one arg");
  28
  29         is(exception {
  30             is($o->$meth('foo', 'bar'), q{}, "$meth_name - empty \@rest list");
  31         }, undef, '...and validates');
  32
  33         is(exception {
  34             is($o->$meth('foo', 'bar', 1 .. 6), q{1,2,3,4,5,6},
  35             "$meth_name - non-empty \@rest list");
  36         }, undef, '...and validates');
  37     }
  38 }
  39
  40 {
  41     my $meth = method (Str $foo, Int $bar, Int @rest) {
  42         return join q{,}, @rest;
  43     };
  44
  45     is(exception {
  46         is($o->$meth('foo', 42), q{}, 'empty @rest list passed through');
  47     }, undef, '...and validates');
  48
  49     is(exception {
  50         is($o->$meth('foo', 42, 23, 13), q{23,13}, 'non-empty int @rest list passed through');
  51     }, undef, '...and validates');
  52
  53     like(exception {
  54         $o->$meth('foo', 42, 'moo', 13, 'non-empty str @rest list passed through');
  55     }, qr/\@rest\b.+\bValidation failed/, "...and doesn't validate");
  56 }
  57
  58 {
  59     my $meth = method (ArrayRef[Int] @foo) {
  60         return join q{,}, map { @{ $_ } } @foo;
  61     };
  62
  63     is(exception {
  64         is($o->$meth([42, 23], [12], [18]), '42,23,12,18', 'int lists passed through');
  65     }, undef, '...and validates');
  66
  67     like(exception {
  68         $o->$meth([42, 23], 12, [18]);
  69     }, qr/Validation failed/, "int doesn't validate against int list");
  70 }
  71
  72 {
  73     my $meth = method (Str $foo, Int @_rest) {};
  74     is(exception { $meth->($o, 'foo') }, undef, 'empty unnamed list validates');
  75     is(exception { $meth->($o, 'foo', 42) }, undef, '1 element of unnamed list validates');
  76     is(exception { $meth->($o, 'foo', 42, 23) }, undef, '2 elements of unnamed list validates');
  77 }
  78
  79 {
  80     eval 'my $meth = method (:$foo, :@bar) { }';
  81     like $@, qr/\bnamed\b.+\bbar\b.+\barray\b/,
  82         'arrays or hashes cannot be named';
  83
  84     eval 'my $meth = method ($foo, @bar, :$baz) { }';
  85     like $@, qr/\bbar\b.+\bbaz\b/,
  86         'named parameters cannot be combined with slurpy positionals';
  87 }