Moose-t-failing/600_todo_tests/002_various_role_features.t

   1 #!/usr/bin/perl
   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
   6 use strict;
   7 use warnings;
   8
   9 use Test::More;
  10 $TODO = q{Mouse is not yet completed};
  11 use Test::Exception;
  12
  13 sub req_or_has ($$) {
  14     my ( $role, $method ) = @_;
  15     local $Test::Builder::Level = $Test::Builder::Level + 1;
  16     if ( $role ) {
  17         ok(
  18             $role->has_method($method) || $role->requires_method($method),
  19             $role->name . " has or requires method $method"
  20         );
  21     } else {
  22         fail("role has or requires method $method");
  23     }
  24 }
  25
  26 {
  27     package Bar;
  28     use Mouse::Role;
  29
  30     # this role eventually adds three methods, qw(foo bar xxy), but only one is
  31     # known when it's still a role
  32
  33     has foo => ( is => "rw" );
  34
  35     has gorch => ( reader => "bar" );
  36
  37     sub xxy { "BAAAD" }
  38
  39     package Gorch;
  40     use Mouse::Role;
  41
  42     # similarly this role gives attr and gorch_method
  43
  44     has attr => ( is => "rw" );
  45
  46     sub gorch_method { "gorch method" }
  47
  48     around dandy => sub { shift->(@_) . "bar" };
  49
  50     package Quxx;
  51     use Mouse;
  52
  53     sub dandy { "foo" }
  54
  55     # this object will be used in an attr of Foo to test that Foo can do the
  56     # Gorch interface
  57
  58     with qw(Gorch);
  59
  60     package Dancer;
  61     use Mouse::Role;
  62
  63     requires "twist";
  64
  65     package Dancer::Ballerina;
  66     use Mouse;
  67
  68     with qw(Dancer);
  69
  70     sub twist { }
  71
  72     sub pirouette { }
  73
  74     package Dancer::Robot;
  75     use Mouse::Role;
  76
  77     # this doesn't fail but it produces a requires in the role
  78     # the order doesn't matter
  79     has twist => ( is => "rw" );
  80     ::lives_ok { with qw(Dancer) };
  81
  82     package Dancer::Something;
  83     use Mouse;
  84
  85     # this fail even though the method already exists
  86
  87     has twist => ( is => "rw" );
  88
  89     {
  90         ::lives_ok { with qw(Dancer) };
  91     }
  92
  93     package Dancer::80s;
  94     use Mouse;
  95
  96     # this should pass because ::Robot has the attribute to fill in the requires
  97     # but due to the deferrence logic that doesn't actually work
  98     {
  99         local our $TODO = "attribute accessor in role doesn't satisfy role requires";
 100         ::lives_ok { with qw(Dancer::Robot) };
 101     }
 102
 103     package Foo;
 104     use Mouse;
 105
 106     with qw(Bar);
 107
 108     has oink => (
 109         is => "rw",
 110         handles => "Gorch", # should handles take the same arguments as 'with'? Meta::Role::Application::Delegation?
 111         default => sub { Quxx->new },
 112     );
 113
 114     has dancer => (
 115         is => "rw",
 116         does => "Dancer",
 117         handles => "Dancer",
 118         default => sub { Dancer::Ballerina->new },
 119     );
 120
 121     sub foo { 42 }
 122
 123     sub bar { 33 }
 124
 125     sub xxy { 7 }
 126
 127     package Tree;
 128     use Mouse::Role;
 129
 130     has bark => ( is => "rw" );
 131
 132     package Dog;
 133     use Mouse::Role;
 134
 135     sub bark { warn "woof!" };
 136
 137     package EntPuppy;
 138     use Mouse;
 139
 140     {
 141         local our $TODO = "attrs and methods from a role should clash";
 142         ::dies_ok { with qw(Tree Dog) }
 143     }
 144 }
 145
 146 # these fail because of the deferral logic winning over actual methods
 147 # this might be tricky to fix due to the 'sub foo {}; has foo => ( )' hack
 148 # we've been doing for a long while, though I doubt people relied on it for
 149 # anything other than fulfilling 'requires'
 150 {
 151     local $TODO = "attributes from role overwrite class methods";
 152     is( Foo->new->foo, 42, "attr did not zap overriding method" );
 153     is( Foo->new->bar, 33, "attr did not zap overriding method" );
 154 }
 155 is( Foo->new->xxy, 7, "method did not zap overriding method" ); # duh
 156
 157 # these pass, simple delegate
 158 # mostly they are here to contrast the next blck
 159 can_ok( Foo->new->oink, "dandy" );
 160 can_ok( Foo->new->oink, "attr" );
 161 can_ok( Foo->new->oink, "gorch_method" );
 162
 163 ok( Foo->new->oink->does("Gorch"), "Quxx does Gorch" );
 164
 165
 166 # these are broken because 'attr' is not technically part of the interface
 167 can_ok( Foo->new, "gorch_method" );
 168 {
 169     local $TODO = "accessor methods from a role are omitted in handles role";
 170     can_ok( Foo->new, "attr" );
 171 }
 172
 173 {
 174     local $TODO = "handles role doesn't add the role to the ->does of the delegate's parent class";
 175     ok( Foo->new->does("Gorch"), "Foo does Gorch" );
 176 }
 177
 178
 179 # these work
 180 can_ok( Foo->new->dancer, "pirouette" );
 181 can_ok( Foo->new->dancer, "twist" );
 182
 183 can_ok( Foo->new, "twist" );
 184 ok( !Foo->new->can("pirouette"), "can't pirouette, not part of the iface" );
 185
 186 {
 187     local $TODO = "handles role doesn't add the role to the ->does of the delegate's parent class";
 188     ok( Foo->new->does("Dancer") );
 189 }
 190
 191
 192
 193
 194 my $gorch = Gorch->meta;
 195
 196 isa_ok( $gorch, "Mouse::Meta::Role" );
 197
 198 ok( $gorch->has_attribute("attr"), "has attribute 'attr'" );
 199 isa_ok( $gorch->get_attribute("attr"), "Mouse::Meta::Role::Attribute" );
 200
 201 req_or_has($gorch, "gorch_method");
 202 ok( $gorch->has_method("gorch_method"), "has_method gorch_method" );
 203 ok( !$gorch->requires_method("gorch_method"), "requires gorch method" );
 204 isa_ok( $gorch->get_method("gorch_method"), "Mouse::Meta::Method" );
 205
 206 {
 207     local $TODO = "method modifier doesn't yet create a method requirement or meta object";
 208     req_or_has($gorch, "dandy" );
 209
 210     # this specific test is maybe not backwards compat, but in theory it *does*
 211     # require that method to exist
 212     ok( $gorch->requires_method("dandy"), "requires the dandy method for the modifier" );
 213 }
 214
 215 {
 216     local $TODO = "attribute related methods are not yet known by the role";
 217     # we want this to be a part of the interface, somehow
 218     req_or_has($gorch, "attr");
 219     ok( $gorch->has_method("attr"), "has_method attr" );
 220     isa_ok( $gorch->get_method("attr"), "Mouse::Meta::Method" );
 221     isa_ok( $gorch->get_method("attr"), "Mouse::Meta::Method" );
 222 }
 223
 224 my $robot = Dancer::Robot->meta;
 225
 226 isa_ok( $robot, "Mouse::Meta::Role" );
 227
 228 ok( $robot->has_attribute("twist"), "has attr 'twist'" );
 229 isa_ok( $robot->get_attribute("twist"), "Mouse::Meta::Role::Attribute" );
 230
 231 {
 232     req_or_has($robot, "twist");
 233
 234     local $TODO = "attribute related methods are not yet known by the role";
 235     ok( $robot->has_method("twist"), "has twist method" );
 236     isa_ok( $robot->get_method("twist"), "Mouse::Meta::Method" );
 237     isa_ok( $robot->get_method("twist"), "Mouse::Meta::Method" );
 238 }
 239
 240 done_testing;
 241
 242 __END__
 243
 244 I think Attribute needs to be refactored in some way to better support roles.
 245
 246 There are several possible ways to do this, all of them seem plausible to me.
 247
 248 The first approach would be to change the attribute class to allow it to be
 249 queried about the methods it would install.
 250
 251 Then we instantiate the attribute in the role, and instead of deferring the
 252 arguments, we just make an C<unpack>ish method.
 253
 254 Then we can interrogate the attr when adding it to the role, and generate stub
 255 methods for all the methods it would produce.
 256
 257 A second approach is kinda like the Immutable hack: wrap the attr in an
 258 anonmyous class that disables part of its interface.
 259
 260 A third method would be to create an Attribute::Partial object that would
 261 provide a more role-ish behavior, and to do this independently of the actual
 262 Attribute class.
 263
 264 Something similar can be done for method modifiers, but I think that's even simpler.
 265
 266
 267
 268 The benefits of doing this are:
 269
 270 * Much better introspection of roles
 271
 272 * More correctness in many cases (in my opinion anyway)
 273
 274 * More roles are more usable as interface declarations, without having to split
 275   them into two pieces (one for the interface with a bunch of requires(), and
 276   another for the actual impl with the problematic attrs (and stub methods to
 277   fix the accessors) and method modifiers (dunno if this can even work at all)
 278
 279