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