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

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