allow creating abstract subclasses

4 files changed, 16 insertions, 5 deletions

diff --git a/lib/MooseX/ABC.pm b/lib/MooseX/ABC.pm
index 11ec50b..6748acb 100644
--- a/lib/MooseX/ABC.pm
+++ b/lib/MooseX/ABC.pm
@@ -66,7 +66,9 @@ sub init_meta {
     my ($package, %options) = @_;
     Carp::confess("Can't make a role into an abstract base class")
         if Class::MOP::class_of($options{for_class})->isa('Moose::Meta::Role');
-    goto $init_meta if $init_meta;
+    my $ret = $init_meta->(@_);
+    Class::MOP::class_of($options{for_class})->is_abstract(1);
+    return $ret;
 }
 
 =head1 TODO
diff --git a/lib/MooseX/ABC/Role/Object.pm b/lib/MooseX/ABC/Role/Object.pm
index 8e6ce60..765ef64 100644
--- a/lib/MooseX/ABC/Role/Object.pm
+++ b/lib/MooseX/ABC/Role/Object.pm
@@ -17,7 +17,7 @@ around new => sub {
     my $class = shift;
     my $meta = Class::MOP::class_of($class);
     $meta->throw_error("$class is abstract, it cannot be instantiated")
-        if $meta->has_required_methods;
+        if $meta->is_abstract;
     $class->$orig(@_);
 };
 
diff --git a/lib/MooseX/ABC/Trait/Class.pm b/lib/MooseX/ABC/Trait/Class.pm
index edc91d2..e54e70b 100644
--- a/lib/MooseX/ABC/Trait/Class.pm
+++ b/lib/MooseX/ABC/Trait/Class.pm
@@ -12,6 +12,12 @@ dying if a subclass doesn't implement the required methods.
 
 =cut
 
+has is_abstract => (
+    is      => 'rw',
+    isa     => 'Bool',
+    default => 0,
+);
+
 has required_methods => (
     traits     => ['Array'],
     is         => 'ro',
@@ -26,12 +32,14 @@ has required_methods => (
 
 after _superclasses_updated => sub {
     my $self = shift;
+    return if $self->is_abstract;
     my @supers = $self->linearized_isa;
     shift @supers;
     for my $superclass (@supers) {
         my $super_meta = Class::MOP::class_of($superclass);
         next unless $super_meta->meta->can('does_role')
                  && $super_meta->meta->does_role('MooseX::ABC::Trait::Class');
+        next unless $super_meta->is_abstract;
         for my $method ($super_meta->required_methods) {
             if (!$self->find_method_by_name($method)) {
                 my $classname = $self->name;
@@ -48,7 +56,7 @@ around _immutable_options => sub {
     my $self = shift;
     my @options = $self->$orig(@_);
     my $constructor = $self->find_method_by_name('new');
-    if ($self->has_required_methods) {
+    if ($self->is_abstract) {
         push @options, inline_constructor => 0;
     }
     # we know that the base class has at least our base class role applied,
@@ -57,7 +65,7 @@ around _immutable_options => sub {
         && $constructor->get_original_method == Class::MOP::class_of('Moose::Object')->get_method('new')) {
         push @options, replace_constructor => 1;
     }
-    # if our parent has been inlined and we have no required methods, then it's
+    # if our parent has been inlined and we are not abstract, then it's
     # safe to inline ourselves
     elsif ($constructor->isa('Moose::Meta::Method::Constructor')) {
         push @options, replace_constructor => 1;
diff --git a/t/004-abstract-subclass.t b/t/004-abstract-subclass.t
index 3f57b59..5f4f86a 100644
--- a/t/004-abstract-subclass.t
+++ b/t/004-abstract-subclass.t
@@ -14,9 +14,10 @@ requires 'bar';
 package Foo::Sub;
 use Moose;
 use MooseX::ABC;
-requires 'foo';
 extends 'Foo';
 
+requires 'foo';
+
 sub bar { 'BAR' }
 
 package Foo::Sub::Sub;