t/020_attributes/005_attribute_does.t

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