t/010_basics/021-moose-object-does.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More;
   5 use Test::Moose;
   6
   7 {
   8     package Role::A;
   9     use Moose::Role
  10 }
  11
  12 {
  13     package Role::B;
  14     use Moose::Role
  15 }
  16
  17 {
  18     package Foo;
  19     use Moose;
  20 }
  21
  22 {
  23     package Bar;
  24     use Moose;
  25
  26     with 'Role::A';
  27 }
  28
  29 {
  30     package Baz;
  31     use Moose;
  32
  33     with qw( Role::A Role::B );
  34 }
  35
  36 {
  37     package Bar::Child;
  38     use Moose;
  39
  40     extends 'Bar';
  41 }
  42
  43 {
  44     package Baz::Child;
  45     use Moose;
  46
  47     extends 'Baz';
  48 }
  49
  50 with_immutable {
  51
  52     for my $thing ( 'Foo', Foo->new ) {
  53         my $name = ref $thing ? 'Foo object' : 'Foo class';
  54         $name .= ' (immutable)' if $thing->meta->is_immutable;
  55
  56         ok(
  57             !$thing->does('Role::A'),
  58             "$name does not do Role::A"
  59         );
  60         ok(
  61             !$thing->does('Role::B'),
  62             "$name does not do Role::B"
  63         );
  64
  65         ok(
  66             !$thing->does( Role::A->meta ),
  67             "$name does not do Role::A (passed as object)"
  68         );
  69         ok(
  70             !$thing->does( Role::B->meta ),
  71             "$name does not do Role::B (passed as object)"
  72         );
  73
  74         ok(
  75             !$thing->DOES('Role::A'),
  76             "$name does not do Role::A (using DOES)"
  77         );
  78         ok(
  79             !$thing->DOES('Role::B'),
  80             "$name does not do Role::B (using DOES)"
  81         );
  82     }
  83
  84     for my $thing ( 'Bar', Bar->new, 'Bar::Child', Bar::Child->new ) {
  85         my $name = ref $thing ? 'Bar object' : 'Bar class';
  86         $name .= ' (immutable)' if $thing->meta->is_immutable;
  87
  88         ok(
  89             $thing->does('Role::A'),
  90             "$name does Role::A"
  91         );
  92         ok(
  93             !$thing->does('Role::B'),
  94             "$name does not do Role::B"
  95         );
  96
  97         ok(
  98             $thing->does( Role::A->meta ),
  99             "$name does Role::A (passed as object)"
 100         );
 101         ok(
 102             !$thing->does( Role::B->meta ),
 103             "$name does not do Role::B (passed as object)"
 104         );
 105
 106         ok(
 107             $thing->DOES('Role::A'),
 108             "$name does Role::A (using DOES)"
 109         );
 110         ok(
 111             !$thing->DOES('Role::B'),
 112             "$name does not do Role::B (using DOES)"
 113         );
 114     }
 115
 116     for my $thing ( 'Baz', Baz->new, 'Baz::Child', Baz::Child->new ) {
 117         my $name = ref $thing ? 'Baz object' : 'Baz class';
 118         $name .= ' (immutable)' if $thing->meta->is_immutable;
 119
 120         ok(
 121             $thing->does('Role::A'),
 122             "$name does Role::A"
 123         );
 124         ok(
 125             $thing->does('Role::B'),
 126             "$name does Role::B"
 127         );
 128
 129         ok(
 130             $thing->does( Role::A->meta ),
 131             "$name does Role::A (passed as object)"
 132         );
 133         ok(
 134             $thing->does( Role::B->meta ),
 135             "$name does Role::B (passed as object)"
 136         );
 137
 138         ok(
 139             $thing->DOES('Role::A'),
 140             "$name does Role::A (using DOES)"
 141         );
 142         ok(
 143             $thing->DOES('Role::B'),
 144             "$name does Role::B (using DOES)"
 145         );
 146     }
 147
 148 }
 149 qw( Foo Bar Baz );
 150
 151 done_testing;