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
 122 # these fail because of the deferral logic winning over actual methods
 123 # this might be tricky to fix due to the 'sub foo {}; has foo => ( )' hack
 124 # we've been doing for a long while, though I doubt people relied on it for
 125 # anything other than fulfilling 'requires'
 126 {
 127     local $TODO = "attributes from role overwrite class methods";
 128     is( Foo->new->foo, 42, "attr did not zap overriding method" );
 129     is( Foo->new->bar, 33, "attr did not zap overriding method" );
 130 }
 131 is( Foo->new->xxy, 7, "method did not zap overriding method" ); # duh
 132
 133 # these pass, simple delegate
 134 # mostly they are here to contrast the next blck
 135 can_ok( Foo->new->oink, "dandy" );
 136 can_ok( Foo->new->oink, "attr" );
 137 can_ok( Foo->new->oink, "gorch_method" );
 138
 139 ok( Foo->new->oink->does("Gorch"), "Quxx does Gorch" );
 140
 141
 142 # these are broken because 'attr' is not technically part of the interface
 143 can_ok( Foo->new, "gorch_method" );
 144 {
 145     local $TODO = "accessor methods from a role are omitted in handles role";
 146     can_ok( Foo->new, "attr" );
 147 }
 148
 149 {
 150     local $TODO = "handles role doesn't add the role to the ->does of the delegate's parent class";
 151     ok( Foo->new->does("Gorch"), "Foo does Gorch" );
 152 }
 153
 154
 155 # these work
 156 can_ok( Foo->new->dancer, "pirouette" );
 157 can_ok( Foo->new->dancer, "twist" );
 158
 159 can_ok( Foo->new, "twist" );
 160 ok( !Foo->new->can("pirouette"), "can't pirouette, not part of the iface" );
 161
 162 {
 163     local $TODO = "handles role doesn't add the role to the ->does of the delegate's parent class";
 164     ok( Foo->new->does("Dancer") );
 165 }
 166
 167
 168
 169
 170 my $gorch = Gorch->meta;
 171
 172 isa_ok( $gorch, "Moose::Meta::Role" );
 173
 174 ok( $gorch->has_attribute("attr"), "has attribute 'attr'" );
 175
 176 {
 177     local $TODO = "role attribute isn't a meta attribute yet";
 178     isa_ok( $gorch->get_attribute("attr"), "Moose::Meta::Attribute" );
 179 }
 180
 181 req_or_has($gorch, "gorch_method");
 182 ok( $gorch->has_method("gorch_method"), "has_method gorch_method" );
 183 ok( !$gorch->requires_method("gorch_method"), "requires gorch method" );
 184
 185 {
 186     local $TODO = "role method isn't a meta object yet";
 187     isa_ok( $gorch->get_method("gorch_method"), "Moose::Meta::Method" );
 188 }
 189
 190 {
 191     local $TODO = "method modifier doesn't yet create a method requirement or meta object";
 192     req_or_has($gorch, "dandy" );
 193
 194     # this specific test is maybe not backwards compat, but in theory it *does*
 195     # require that method to exist
 196     ok( $gorch->requires_method("dandy"), "requires the dandy method for the modifier" );
 197 }
 198
 199 {
 200     local $TODO = "attribute related methods are not yet known by the role";
 201     # we want this to be a part of the interface, somehow
 202     req_or_has($gorch, "attr");
 203     ok( $gorch->has_method("attr"), "has_method attr" );
 204     isa_ok( $gorch->get_method("attr"), "Moose::Meta::Method" );
 205     isa_ok( $gorch->get_method("attr"), "Moose::Meta::Method::Accessor" );
 206 }
 207
 208 my $robot = Dancer::Robot->meta;
 209
 210 isa_ok( $robot, "Moose::Meta::Role" );
 211
 212 ok( $robot->has_attribute("twist"), "has attr 'twist'" );
 213
 214 {
 215     local $TODO = "role attribute isn't a meta attribute yet";
 216     isa_ok( $robot->get_attribute("twist"), "Moose::Meta::Attribute" );
 217 }
 218
 219 {
 220     local $TODO = "attribute related methods are not yet known by the role";
 221     req_or_has($robot, "twist");
 222     ok( $robot->has_method("twist"), "has twist method" );
 223     isa_ok( $robot->get_method("twist"), "Moose::Meta::Method" );
 224     isa_ok( $robot->get_method("twist"), "Moose::Meta::Method::Accessor" );
 225 }
 226
 227 __END__
 228
 229 I think Attribute needs to be refactored in some way to better support roles.
 230
 231 There are several possible ways to do this, all of them seem plausible to me.
 232
 233 The first approach would be to change the attribute class to allow it to be
 234 queried about the methods it would install.
 235
 236 Then we instantiate the attribute in the role, and instead of deferring the
 237 arguments, we just make an C<unpack>ish method.
 238
 239 Then we can interrogate the attr when adding it to the role, and generate stub
 240 methods for all the methods it would produce.
 241
 242 A second approach is kinda like the Immutable hack: wrap the attr in an
 243 anonmyous class that disables part of its interface.
 244
 245 A third method would be to create an Attribute::Partial object that would
 246 provide a more role-ish behavior, and to do this independently of the actual
 247 Attribute class.
 248
 249 Something similar can be done for method modifiers, but I think that's even simpler.
 250
 251
 252
 253 The benefits of doing this are:
 254
 255 * Much better introspection of roles
 256
 257 * More correctness in many cases (in my opinion anyway)
 258
 259 * More roles are more usable as interface declarations, without having to split
 260   them into two pieces (one for the interface with a bunch of requires(), and
 261   another for the actual impl with the problematic attrs (and stub methods to
 262   fix the accessors) and method modifiers (dunno if this can even work at all)
 263
 264