t/todo_tests/various_role_features.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7 use Test::Fatal;
   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     ::is( ::exception { with qw(Dancer) }, undef );
  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         ::is( ::exception { with qw(Dancer) }, undef );
  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         ::is( ::exception { with qw(Dancer::Robot) }, undef );
  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         ::isnt( ::exception { with qw(Tree Dog) }, undef );
 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 isa_ok( $gorch->get_attribute("attr"), "Moose::Meta::Role::Attribute" );
 196
 197 req_or_has($gorch, "gorch_method");
 198 ok( $gorch->has_method("gorch_method"), "has_method gorch_method" );
 199 ok( !$gorch->requires_method("gorch_method"), "requires gorch method" );
 200 isa_ok( $gorch->get_method("gorch_method"), "Moose::Meta::Method" );
 201
 202 {
 203     local $TODO = "method modifier doesn't yet create a method requirement or meta object";
 204     req_or_has($gorch, "dandy" );
 205
 206     # this specific test is maybe not backwards compat, but in theory it *does*
 207     # require that method to exist
 208     ok( $gorch->requires_method("dandy"), "requires the dandy method for the modifier" );
 209 }
 210
 211 {
 212     local $TODO = "attribute related methods are not yet known by the role";
 213     # we want this to be a part of the interface, somehow
 214     req_or_has($gorch, "attr");
 215     ok( $gorch->has_method("attr"), "has_method attr" );
 216     isa_ok( $gorch->get_method("attr"), "Moose::Meta::Method" );
 217     isa_ok( $gorch->get_method("attr"), "Moose::Meta::Method::Accessor" );
 218 }
 219
 220 my $robot = Dancer::Robot->meta;
 221
 222 isa_ok( $robot, "Moose::Meta::Role" );
 223
 224 ok( $robot->has_attribute("twist"), "has attr 'twist'" );
 225 isa_ok( $robot->get_attribute("twist"), "Moose::Meta::Role::Attribute" );
 226
 227 {
 228     req_or_has($robot, "twist");
 229
 230     local $TODO = "attribute related methods are not yet known by the role";
 231     ok( $robot->has_method("twist"), "has twist method" );
 232     isa_ok( $robot->get_method("twist"), "Moose::Meta::Method" );
 233     isa_ok( $robot->get_method("twist"), "Moose::Meta::Method::Accessor" );
 234 }
 235
 236 done_testing;
 237
 238 __END__
 239
 240 I think Attribute needs to be refactored in some way to better support roles.
 241
 242 There are several possible ways to do this, all of them seem plausible to me.
 243
 244 The first approach would be to change the attribute class to allow it to be
 245 queried about the methods it would install.
 246
 247 Then we instantiate the attribute in the role, and instead of deferring the
 248 arguments, we just make an C<unpack>ish method.
 249
 250 Then we can interrogate the attr when adding it to the role, and generate stub
 251 methods for all the methods it would produce.
 252
 253 A second approach is kinda like the Immutable hack: wrap the attr in an
 254 anonmyous class that disables part of its interface.
 255
 256 A third method would be to create an Attribute::Partial object that would
 257 provide a more role-ish behavior, and to do this independently of the actual
 258 Attribute class.
 259
 260 Something similar can be done for method modifiers, but I think that's even simpler.
 261
 262
 263
 264 The benefits of doing this are:
 265
 266 * Much better introspection of roles
 267
 268 * More correctness in many cases (in my opinion anyway)
 269
 270 * More roles are more usable as interface declarations, without having to split
 271   them into two pieces (one for the interface with a bunch of requires(), and
 272   another for the actual impl with the problematic attrs (and stub methods to
 273   fix the accessors) and method modifiers (dunno if this can even work at all)
 274
 275