t/001_mouse/034-apply_all_roles.t

   1 #!perl
   2 use strict;
   3 use warnings;
   4 use Test::More;
   5
   6 my $foo = 0;
   7 my $bar = 0;
   8 {
   9     package FooRole;
  10     use Mouse::Role;
  11     sub foo { 'ok1' }
  12
  13     before method => sub { $foo++ };
  14 }
  15
  16 {
  17     package BarRole;
  18     use Mouse::Role;
  19     sub bar { 'ok2' }
  20
  21     before method => sub { $bar++ };
  22 }
  23
  24 {
  25     package Baz;
  26     use Mouse;
  27     sub method {}
  28     no Mouse;
  29 }
  30
  31 {
  32     package Qux;
  33     use Mouse;
  34     sub method {}
  35     no Mouse;
  36 }
  37
  38 Mouse::Util::apply_all_roles('Baz', 'BarRole', 'FooRole');
  39
  40 my $baz = Baz->new;
  41 is $baz->foo, 'ok1';
  42 is $baz->bar, 'ok2';
  43 is join(",", sort $baz->meta->get_method_list), 'bar,foo,meta,method';
  44
  45 # applyu to instance
  46
  47 my $qux = Qux->new;
  48 Mouse::Util::apply_all_roles($qux, 'FooRole');
  49 note $qux;
  50 $foo = 0;
  51 $bar = 0;
  52 $qux->method;
  53 is $foo, 1;
  54 is $bar, 0;
  55
  56 $qux = Qux->new;
  57 Mouse::Util::apply_all_roles($qux, 'BarRole');
  58 note $qux;
  59 $foo = 0;
  60 $bar = 0;
  61 $qux->method;
  62 is $foo, 0;
  63 is $bar, 1;
  64
  65 $qux = Qux->new;
  66 Mouse::Util::apply_all_roles($qux, 'FooRole', 'BarRole');
  67 note $qux;
  68 $foo = 0;
  69 $bar = 0;
  70 $qux->method;
  71 is $foo, 1;
  72 is $bar, 1;
  73
  74 done_testing;
  75