t/600_todo_tests/002_various_role_shit.t

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