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

   1 #!perl
   2 use strict;
   3 use warnings FATAL => 'all';
   4 use Test::More tests => 23;
   5 use Test::Fatal;
   6 use Function::Parameters qw(:strict);
   7
   8 my $o = bless {} => 'Foo';
   9
  10 {
  11     my @meths = (
  12         method ($foo, $bar, @rest) {
  13             return join q{,}, @rest;
  14         },
  15         method ($foo, $bar, %rest) {
  16             return join q{,}, map { $_ => $rest{$_} } sort keys %rest;
  17         },
  18     );
  19
  20     for my $meth (@meths) {
  21         ok(exception { $o->$meth() });
  22         ok(exception { $o->$meth('foo') });
  23
  24         is(exception {
  25             is($o->$meth('foo', 'bar'), q{});
  26         }, undef);
  27
  28         is(exception {
  29             is($o->$meth('foo', 'bar', 1 .. 6), q{1,2,3,4,5,6});
  30         }, undef);
  31     }
  32 }
  33
  34 {
  35     my $meth = method ($foo, $bar, @rest) {
  36         return join q{,}, @rest;
  37     };
  38
  39     is(exception {
  40         is($o->$meth('foo', 42), q{});
  41     }, undef);
  42
  43     is(exception {
  44         is($o->$meth('foo', 42, 23, 13), q{23,13});
  45     }, undef);
  46
  47 #    like(exception {
  48 #        $o->$meth('foo', 42, 'moo', 13);
  49 #    }, qr/Validation failed/);
  50 }
  51
  52 {
  53     my $meth = method (@foo) {
  54         return join q{,}, map { @{ $_ } } @foo;
  55     };
  56
  57     is(exception {
  58         is($o->$meth([42, 23], [12], [18]), '42,23,12,18');
  59     }, undef);
  60
  61 #    like(exception {
  62 #        $o->$meth([42, 23], 12, [18]);
  63 #    }, qr/Validation failed/);
  64 }
  65
  66 {
  67     my $meth = method ($foo, @_rest) {};
  68     is(exception { $meth->($o, 'foo') }, undef);
  69     is(exception { $meth->($o, 'foo', 42) }, undef);
  70     is(exception { $meth->($o, 'foo', 42, 23) }, undef);
  71 }
  72
  73 {
  74     eval 'my $meth = method (:$foo, :@bar) { }';
  75     like $@, qr/\bnamed\b.+\bbar\b.+\barray\b/;
  76
  77     eval 'my $meth = method ($foo, @bar, :$baz) { }';
  78     like $@, qr/\bbar\b.+\bbaz\b/;
  79 }