t/basics/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 Foo::Child;
  38     use Moose;
  39
  40     extends 'Foo';
  41 }
  42
  43 {
  44     package Bar::Child;
  45     use Moose;
  46
  47     extends 'Bar';
  48 }
  49
  50 {
  51     package Baz::Child;
  52     use Moose;
  53
  54     extends 'Baz';
  55 }
  56
  57 with_immutable {
  58
  59     for my $thing ( 'Foo', Foo->new, 'Foo::Child', Foo::Child->new ) {
  60         my $name = ref $thing ? (ref $thing) . ' object' : "$thing class";
  61         $name .= ' (immutable)' if $thing->meta->is_immutable;
  62
  63         ok(
  64             !$thing->does('Role::A'),
  65             "$name does not do Role::A"
  66         );
  67         ok(
  68             !$thing->does('Role::B'),
  69             "$name does not do Role::B"
  70         );
  71
  72         ok(
  73             !$thing->does( Role::A->meta ),
  74             "$name does not do Role::A (passed as object)"
  75         );
  76         ok(
  77             !$thing->does( Role::B->meta ),
  78             "$name does not do Role::B (passed as object)"
  79         );
  80
  81         ok(
  82             !$thing->DOES('Role::A'),
  83             "$name does not do Role::A (using DOES)"
  84         );
  85         ok(
  86             !$thing->DOES('Role::B'),
  87             "$name does not do Role::B (using DOES)"
  88         );
  89     }
  90
  91     for my $thing ( 'Bar', Bar->new, 'Bar::Child', Bar::Child->new ) {
  92         my $name = ref $thing ? (ref $thing) . ' object' : "$thing class";
  93         $name .= ' (immutable)' if $thing->meta->is_immutable;
  94
  95         ok(
  96             $thing->does('Role::A'),
  97             "$name does Role::A"
  98         );
  99         ok(
 100             !$thing->does('Role::B'),
 101             "$name does not do Role::B"
 102         );
 103
 104         ok(
 105             $thing->does( Role::A->meta ),
 106             "$name does Role::A (passed as object)"
 107         );
 108         ok(
 109             !$thing->does( Role::B->meta ),
 110             "$name does not do Role::B (passed as object)"
 111         );
 112
 113         ok(
 114             $thing->DOES('Role::A'),
 115             "$name does Role::A (using DOES)"
 116         );
 117         ok(
 118             !$thing->DOES('Role::B'),
 119             "$name does not do Role::B (using DOES)"
 120         );
 121     }
 122
 123     for my $thing ( 'Baz', Baz->new, 'Baz::Child', Baz::Child->new ) {
 124         my $name = ref $thing ? (ref $thing) . ' object' : "$thing class";
 125         $name .= ' (immutable)' if $thing->meta->is_immutable;
 126
 127         ok(
 128             $thing->does('Role::A'),
 129             "$name does Role::A"
 130         );
 131         ok(
 132             $thing->does('Role::B'),
 133             "$name does Role::B"
 134         );
 135
 136         ok(
 137             $thing->does( Role::A->meta ),
 138             "$name does Role::A (passed as object)"
 139         );
 140         ok(
 141             $thing->does( Role::B->meta ),
 142             "$name does Role::B (passed as object)"
 143         );
 144
 145         ok(
 146             $thing->DOES('Role::A'),
 147             "$name does Role::A (using DOES)"
 148         );
 149         ok(
 150             $thing->DOES('Role::B'),
 151             "$name does Role::B (using DOES)"
 152         );
 153     }
 154
 155 }
 156 qw( Foo Bar Baz Foo::Child Bar::Child Baz::Child );
 157
 158 done_testing;