From: Dave Rolsky <autarch@urth.org>
Date: Sat, 19 Mar 2011 22:47:56 +0000 (-0500)
Subject: Croak with useful errors when trying to apply meta/base roles to a non-Moose class
X-Git-Tag: 1.9905~1
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4e5b5d20c177ad32e7e890285b339924a196015c;p=gitmo%2FMoose.git

Croak with useful errors when trying to apply meta/base roles to a non-Moose class
---

diff --git a/Changes b/Changes
index 05b4a7e..18efeaf 100644
--- a/Changes
+++ b/Changes
@@ -9,6 +9,12 @@ for, noteworthy changes.
     which returns the role which first defined an attribute. See the docs for
     details. (Dave Rolsky)
 
+  * Moose::Util::MetaRole will make sure that the class to which you're
+    applying metaroles or base class roles can actually have them applied. If
+    not (it's not a Moose class, it has a non-Moose metaclass, etc.), then it
+    gives a useful error message. Previously, this would just end up dying in
+    the MetaRole code without a useful message. (Dave Rolsky)
+
   [BUG FIXES]
 
   * When a role had its own applied_attribute metaclass (usually from MetaRole
diff --git a/lib/Moose/Util/MetaRole.pm b/lib/Moose/Util/MetaRole.pm
index ed8e0cc..150382e 100644
--- a/lib/Moose/Util/MetaRole.pm
+++ b/lib/Moose/Util/MetaRole.pm
@@ -4,9 +4,11 @@ use strict;
 use warnings;
 use Scalar::Util 'blessed';
 
+use Carp qw( croak );
 use List::MoreUtils qw( all );
 use List::Util qw( first );
 use Moose::Deprecated;
+use Scalar::Util qw( blessed );
 
 sub apply_metaclass_roles {
     Moose::Deprecated::deprecated(
@@ -24,10 +26,7 @@ sub apply_metaroles {
 
     _fixup_old_style_args(\%args);
 
-    my $for
-        = blessed $args{for}
-        ? $args{for}
-        : Class::MOP::class_of( $args{for} );
+    my $for = _metathing_for( $args{for} );
 
     if ( $for->isa('Moose::Meta::Role') ) {
         return _make_new_metaclass( $for, $args{role_metaroles}, 'role' );
@@ -37,6 +36,46 @@ sub apply_metaroles {
     }
 }
 
+sub _metathing_for {
+    my $passed = shift;
+
+    my $found
+        = blessed $passed
+        ? $passed
+        : Class::MOP::class_of($passed);
+
+    return $found
+        if defined $found
+            && blessed $found
+            && (   $found->isa('Moose::Meta::Role')
+                || $found->isa('Moose::Meta::Class') );
+
+    local $Carp::CarpLevel = $Carp::CarpLevel + 1;
+
+    my $error_start
+        = 'When using Moose::Util::MetaRole, you must pass a Moose class name,'
+        . ' role name, metaclass object, or metarole object.';
+
+    if ( defined $found && blessed $found ) {
+        croak $error_start
+            . " You passed $passed, and we resolved this to a "
+            . ( blessed $found )
+            . ' object.';
+    }
+
+    if ( defined $passed && !defined $found ) {
+        croak $error_start
+            . " You passed $passed, and this did not resolve to a metaclass or metarole."
+            . ' Maybe you need to call Moose->init_meta to initialize the metaclass first?';
+    }
+
+    if ( !defined $passed ) {
+        croak $error_start
+            . " You passed an undef."
+            . ' Maybe you need to call Moose->init_meta to initialize the metaclass first?';
+    }
+}
+
 sub _fixup_old_style_args {
     my $args = shift;
 
@@ -131,12 +170,12 @@ sub _make_new_metaclass {
 sub apply_base_class_roles {
     my %args = @_;
 
-    my $for = $args{for} || $args{for_class};
-
-    my $meta = Class::MOP::class_of($for);
+    my $meta = _metathing_for( $args{for} || $args{for_class} );
+    croak 'You can only apply base class roles to a Moose class, not a role.'
+        if $meta->isa('Moose::Meta::Role');
 
     my $new_base = _make_new_class(
-        $for,
+        $meta->name,
         $args{roles},
         [ $meta->superclasses() ],
     );
diff --git a/t/metaclasses/metarole.t b/t/metaclasses/metarole.t
index 1bdde3e..b733689 100644
--- a/t/metaclasses/metarole.t
+++ b/t/metaclasses/metarole.t
@@ -672,4 +672,56 @@ is( exception {
     );
 }
 
+{
+    package NotMoosey;
+
+    use metaclass;
+}
+
+{
+    like(
+        exception {
+            Moose::Util::MetaRole::apply_metaroles(
+                for             => 'Does::Not::Exist',
+                class_metaroles => { class => ['Role::Foo'] },
+            );
+        },
+        qr/When using Moose::Util::MetaRole.+You passed Does::Not::Exist.+Maybe you need to call.+/,
+        'useful error when apply metaroles to a class without a metaclass'
+    );
+
+    like(
+        exception {
+            Moose::Util::MetaRole::apply_metaroles(
+                for             => 'NotMoosey',
+                class_metaroles => { class => ['Role::Foo'] },
+            );
+        },
+        qr/When using Moose::Util::MetaRole.+You passed NotMoosey.+we resolved this to a Class::MOP::Class object.+/,
+        'useful error when using apply metaroles to a class with a Class::MOP::Class metaclass'
+    );
+
+    like(
+        exception {
+            Moose::Util::MetaRole::apply_base_class_roles(
+                for   => 'NotMoosey',
+                roles => { class => ['Role::Foo'] },
+            );
+        },
+        qr/When using Moose::Util::MetaRole.+You passed NotMoosey.+we resolved this to a Class::MOP::Class object.+/,
+        'useful error when applying base class to roles to a non-Moose class'
+    );
+
+    like(
+        exception {
+            Moose::Util::MetaRole::apply_base_class_roles(
+                for   => 'My::Role',
+                roles => { class => ['Role::Foo'] },
+            );
+        },
+        qr/You can only apply base class roles to a Moose class.+/,
+        'useful error when applying base class to roles to a non-Moose class'
+    );
+}
+
 done_testing;