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 qw/ blessed /;
  32             die $_[0] . "Does not have a ->consume method" unless blessed($_[0]) && $_[0]->can('consume'); }),
  33         is => 'ro',
  34         required => 1,
  35         coerce => quote_sub(q{
  36             my %stuff = %{$_[0]};
  37             my $class = delete($stuff{class});
  38             $class->new(%stuff);
  39         }),
  40     );
  41 }
  42
  43 {
  44     package TestMooClass;
  45     use Moo;
  46
  47     with 'TestRole';
  48 }
  49
  50 {
  51     package TestMooseClass;
  52     use Moose;
  53
  54     with 'TestRole';
  55 }
  56
  57 foreach my $name (qw/ TestMooClass TestMooseClass /) {
  58     my $i = $name->new(output_to => TestClientClass->new());
  59     ok $i->output_to->can('consume');
  60     $i = $name->new(output_to => { class => 'TestClientClass' });
  61     ok $i->output_to->can('consume');
  62 };
  63
  64 foreach my $name (qw/ TestMooClass TestMooseClass /) {
  65     ok !exception { TestBadClientClass->new };
  66     ok exception { $name->new(output_to => TestBadClientClass->new()) };
  67     ok exception { $name->new(output_to => { class => 'TestBadClientClass' }) };
  68 }
  69
  70 done_testing;
  71