xt/moo-role-types.t

   1 use strict;
   2 use warnings;
   3 use Test::More;
   4 use Test::Fatal;
   5
   6 {
   7     package TestClientClass;
   8     use Moo;
   9     use namespace::clean -except => 'meta';
  10
  11     sub consume {}
  12 }
  13
  14 {
  15     package TestBadClientClass;
  16     use Moo;
  17     use namespace::clean -except => 'meta';
  18
  19     sub not_consume {}
  20 }
  21
  22 {
  23     package TestRole;
  24     use Moo::Role;
  25     use Sub::Quote;
  26     use namespace::clean -except => 'meta';
  27
  28
  29     has output_to => (
  30         isa => quote_sub(q{
  31             use Scalar::Util ();
  32             die $_[0] . "Does not have a ->consume method" unless Scalar::Util::blessed($_[0]) && $_[0]->can('consume'); }),
  33         is => 'ro',
  34         required => 1,
  35         coerce => quote_sub(q{
  36             use Scalar::Util ();
  37             if (Scalar::Util::blessed($_[0]) && $_[0]->can('consume')) {
  38               $_[0];
  39             } else {
  40               my %stuff = %{$_[0]};
  41               my $class = delete($stuff{class});
  42               $class->new(%stuff);
  43             }
  44         }),
  45     );
  46 }
  47
  48 {
  49     package TestMooClass;
  50     use Moo;
  51
  52     with 'TestRole';
  53 }
  54
  55 {
  56     package TestMooseClass;
  57     use Moose;
  58
  59     with 'TestRole';
  60 }
  61
  62 foreach my $name (qw/ TestMooClass TestMooseClass /) {
  63     my $i = $name->new(output_to => TestClientClass->new());
  64     ok $i->output_to->can('consume');
  65     $i = $name->new(output_to => { class => 'TestClientClass' });
  66     ok $i->output_to->can('consume');
  67 };
  68
  69 foreach my $name (qw/ TestMooClass TestMooseClass /) {
  70     ok !exception { TestBadClientClass->new };
  71     ok exception { $name->new(output_to => TestBadClientClass->new()) };
  72     ok exception { $name->new(output_to => { class => 'TestBadClientClass' }) };
  73 }
  74
  75 done_testing;
  76