t/400_mouse_util/002_mouse_util_does_role.t

   1 #!/usr/bin/perl\r
   2 \r
   3 use strict;\r
   4 use warnings;\r
   5 \r
   6 use Test::More tests => 8;\r
   7 \r
   8 BEGIN {\r
   9     use_ok('Mouse::Util', ':all');\r
  10 }\r
  11 \r
  12 {\r
  13   package Foo;\r
  14 \r
  15   use Mouse::Role;\r
  16 }\r
  17 \r
  18 {\r
  19   package Bar;\r
  20 \r
  21   use Mouse;\r
  22 \r
  23   with qw/Foo/;\r
  24 }\r
  25 \r
  26 {\r
  27   package Baz;\r
  28 \r
  29   use Mouse;\r
  30 }\r
  31 \r
  32 {\r
  33   package Quux;\r
  34 \r
  35   use metaclass;\r
  36 }\r
  37 \r
  38 {\r
  39   package Foo::Foo;\r
  40 \r
  41   use Mouse::Role;\r
  42 \r
  43   with 'Foo';\r
  44 }\r
  45 \r
  46 # Classes\r
  47 \r
  48 ok(does_role('Bar', 'Foo'), '... Bar does Foo');\r
  49 \r
  50 ok(!does_role('Baz', 'Foo'), '... Baz doesnt do Foo');\r
  51 \r
  52 # Objects\r
  53 \r
  54 my $bar = Bar->new;\r
  55 \r
  56 ok(does_role($bar, 'Foo'), '... $bar does Foo');\r
  57 \r
  58 my $baz = Baz->new;\r
  59 \r
  60 ok(!does_role($baz, 'Foo'), '... $baz doesnt do Foo');\r
  61 \r
  62 # Invalid values\r
  63 \r
  64 ok(!does_role(undef,'Foo'), '... undef doesnt do Foo');\r
  65 \r
  66 ok(!does_role(1,'Foo'), '... 1 doesnt do Foo');\r
  67 \r
  68 # non Mouse metaclass\r
  69 \r
  70 ok(!does_role('Quux', 'Foo'), '... Quux doesnt do Foo (does not die tho)');\r
  71 \r
  72 # TODO: make the below work, maybe?\r
  73 \r
  74 # Self\r
  75 \r
  76 #ok(does_role('Foo', 'Foo'), '... Foo does do Foo');\r
  77 \r
  78 # sub-Roles\r
  79 \r
  80 #ok(does_role('Foo::Foo', 'Foo'), '... Foo::Foo does do Foo');\r
  81 \r