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 tests => 39;
   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         ::lives_ok { with qw(Dancer) };
  87     }
  88
  89     package Dancer::80s;
  90     use Moose;
  91
  92     # this should pass because ::Robot has the attribute to fill in the requires
  93     # but due to the deferrence logic that doesn't actually work
  94     {
  95         local our $TODO = "attribute accessor in role doesn't satisfy role requires";
  96         ::lives_ok { with qw(Dancer::Robot) };
  97     }
  98
  99     package Foo;
 100     use Moose;
 101
 102     with qw(Bar);
 103
 104     has oink => (
 105         is => "rw",
 106         handles => "Gorch", # should handles take the same arguments as 'with'? Meta::Role::Application::Delegation?
 107         default => sub { Quxx->new },
 108     );
 109
 110     has dancer => (
 111         is => "rw",
 112         does => "Dancer",
 113         handles => "Dancer",
 114         default => sub { Dancer::Ballerina->new },
 115     );
 116
 117     sub foo { 42 }
 118
 119     sub bar { 33 }
 120
 121     sub xxy { 7 }
 122
 123     package Tree;
 124     use Moose::Role;
 125
 126     has bark => ( is => "rw" );
 127
 128     package Dog;
 129     use Moose::Role;
 130
 131     sub bark { warn "woof!" };
 132
 133     package EntPuppy;
 134     use Moose;
 135
 136     {
 137         local our $TODO = "attrs and methods from a role should clash";
 138         ::dies_ok { with qw(Tree Dog) }
 139     }
 140 }
 141
 142 # these fail because of the deferral logic winning over actual methods
 143 # this might be tricky to fix due to the 'sub foo {}; has foo => ( )' hack
 144 # we've been doing for a long while, though I doubt people relied on it for
 145 # anything other than fulfilling 'requires'
 146 {
 147     local $TODO = "attributes from role overwrite class methods";
 148     is( Foo->new->foo, 42, "attr did not zap overriding method" );
 149     is( Foo->new->bar, 33, "attr did not zap overriding method" );
 150 }
 151 is( Foo->new->xxy, 7, "method did not zap overriding method" ); # duh
 152
 153 # these pass, simple delegate
 154 # mostly they are here to contrast the next blck
 155 can_ok( Foo->new->oink, "dandy" );
 156 can_ok( Foo->new->oink, "attr" );
 157 can_ok( Foo->new->oink, "gorch_method" );
 158
 159 ok( Foo->new->oink->does("Gorch"), "Quxx does Gorch" );
 160
 161
 162 # these are broken because 'attr' is not technically part of the interface
 163 can_ok( Foo->new, "gorch_method" );
 164 {
 165     local $TODO = "accessor methods from a role are omitted in handles role";
 166     can_ok( Foo->new, "attr" );
 167 }
 168
 169 {
 170     local $TODO = "handles role doesn't add the role to the ->does of the delegate's parent class";
 171     ok( Foo->new->does("Gorch"), "Foo does Gorch" );
 172 }
 173
 174
 175 # these work
 176 can_ok( Foo->new->dancer, "pirouette" );
 177 can_ok( Foo->new->dancer, "twist" );
 178
 179 can_ok( Foo->new, "twist" );
 180 ok( !Foo->new->can("pirouette"), "can't pirouette, not part of the iface" );
 181
 182 {
 183     local $TODO = "handles role doesn't add the role to the ->does of the delegate's parent class";
 184     ok( Foo->new->does("Dancer") );
 185 }
 186
 187
 188
 189
 190 my $gorch = Gorch->meta;
 191
 192 isa_ok( $gorch, "Moose::Meta::Role" );
 193
 194 ok( $gorch->has_attribute("attr"), "has attribute 'attr'" );
 195
 196 {
 197     local $TODO = "role attribute isn't a meta attribute yet";
 198     isa_ok( $gorch->get_attribute("attr"), "Moose::Meta::Attribute" );
 199 }
 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"), "Moose::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"), "Moose::Meta::Method" );
 221     isa_ok( $gorch->get_method("attr"), "Moose::Meta::Method::Accessor" );
 222 }
 223
 224 my $robot = Dancer::Robot->meta;
 225
 226 isa_ok( $robot, "Moose::Meta::Role" );
 227
 228 ok( $robot->has_attribute("twist"), "has attr 'twist'" );
 229
 230 {
 231     local $TODO = "role attribute isn't a meta attribute yet";
 232     isa_ok( $robot->get_attribute("twist"), "Moose::Meta::Attribute" );
 233 }
 234
 235 {
 236     req_or_has($robot, "twist");
 237
 238     local $TODO = "attribute related methods are not yet known by the role";
 239     ok( $robot->has_method("twist"), "has twist method" );
 240     isa_ok( $robot->get_method("twist"), "Moose::Meta::Method" );
 241     isa_ok( $robot->get_method("twist"), "Moose::Meta::Method::Accessor" );
 242 }
 243
 244 __END__
 245
 246 I think Attribute needs to be refactored in some way to better support roles.
 247
 248 There are several possible ways to do this, all of them seem plausible to me.
 249
 250 The first approach would be to change the attribute class to allow it to be
 251 queried about the methods it would install.
 252
 253 Then we instantiate the attribute in the role, and instead of deferring the
 254 arguments, we just make an C<unpack>ish method.
 255
 256 Then we can interrogate the attr when adding it to the role, and generate stub
 257 methods for all the methods it would produce.
 258
 259 A second approach is kinda like the Immutable hack: wrap the attr in an
 260 anonmyous class that disables part of its interface.
 261
 262 A third method would be to create an Attribute::Partial object that would
 263 provide a more role-ish behavior, and to do this independently of the actual
 264 Attribute class.
 265
 266 Something similar can be done for method modifiers, but I think that's even simpler.
 267
 268
 269
 270 The benefits of doing this are:
 271
 272 * Much better introspection of roles
 273
 274 * More correctness in many cases (in my opinion anyway)
 275
 276 * More roles are more usable as interface declarations, without having to split
 277   them into two pieces (one for the interface with a bunch of requires(), and
 278   another for the actual impl with the problematic attrs (and stub methods to
 279   fix the accessors) and method modifiers (dunno if this can even work at all)
 280
 281