t/020_attributes/005_attribute_does.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7 use Test::Exception;
   8
   9
  10 {
  11     package Foo::Role;
  12     use Moose::Role;
  13     use Moose::Util::TypeConstraints;
  14
  15     # if does() exists on its own, then
  16     # we create a type constraint for
  17     # it, just as we do for isa()
  18     has 'bar' => (is => 'rw', does => 'Bar::Role');
  19     has 'baz' => (
  20         is   => 'rw',
  21         does => role_type('Bar::Role')
  22     );
  23
  24     package Bar::Role;
  25     use Moose::Role;
  26
  27     # if isa and does appear together, then see if Class->does(Role)
  28     # if it does work... then the does() check is actually not needed
  29     # since the isa() check will imply the does() check
  30     has 'foo' => (is => 'rw', isa => 'Foo::Class', does => 'Foo::Role');
  31
  32     package Foo::Class;
  33     use Moose;
  34
  35     with 'Foo::Role';
  36
  37     package Bar::Class;
  38     use Moose;
  39
  40     with 'Bar::Role';
  41
  42 }
  43
  44 my $foo = Foo::Class->new;
  45 isa_ok($foo, 'Foo::Class');
  46
  47 my $bar = Bar::Class->new;
  48 isa_ok($bar, 'Bar::Class');
  49
  50 lives_ok {
  51     $foo->bar($bar);
  52 } '... bar passed the type constraint okay';
  53
  54 dies_ok {
  55     $foo->bar($foo);
  56 } '... foo did not pass the type constraint okay';
  57
  58 lives_ok {
  59     $foo->baz($bar);
  60 } '... baz passed the type constraint okay';
  61
  62 dies_ok {
  63     $foo->baz($foo);
  64 } '... foo did not pass the type constraint okay';
  65
  66 lives_ok {
  67     $bar->foo($foo);
  68 } '... foo passed the type constraint okay';
  69
  70
  71
  72 # some error conditions
  73
  74 {
  75     package Baz::Class;
  76     use Moose;
  77
  78     # if isa and does appear together, then see if Class->does(Role)
  79     # if it does not,.. we have a conflict... so we die loudly
  80     ::dies_ok {
  81         has 'foo' => (isa => 'Foo::Class', does => 'Bar::Class');
  82     } '... cannot have a does() which is not done by the isa()';
  83 }
  84
  85 {
  86     package Bling;
  87     use strict;
  88     use warnings;
  89
  90     sub bling { 'Bling::bling' }
  91
  92     package Bling::Bling;
  93     use Moose;
  94
  95     # if isa and does appear together, then see if Class->does(Role)
  96     # if it does not,.. we have a conflict... so we die loudly
  97     ::dies_ok {
  98         has 'foo' => (isa => 'Bling', does => 'Bar::Class');
  99     } '... cannot have a isa() which is cannot does()';
 100 }
 101
 102 done_testing;