Skip class_type etc stack frames when checking the package that defines a subtype

diff --git a/lib/Mouse/Util/TypeConstraints.pm b/lib/Mouse/Util/TypeConstraints.pm
index 54246b8..0edd9b6 100644 (file)
--- a/lib/Mouse/Util/TypeConstraints.pm
+++ b/lib/Mouse/Util/TypeConstraints.pm
@@ -151,7 +151,7 @@ sub subtype {
 
     $name = '__ANON__' if !defined $name;
 
-    my $pkg = caller;
+    my $pkg = caller($conf{_caller_level} || 1);
 
     if ($TYPE{$name} && $TYPE_SOURCE{$name} ne $pkg) {
         Carp::croak "The type constraint '$name' has already been created in $TYPE_SOURCE{$name} and cannot be created again in $pkg";
@@ -218,11 +218,15 @@ sub class_type {
     if ($conf && $conf->{class}) {
         # No, you're using this wrong
         warn "class_type() should be class_type(ClassName). Perhaps you're looking for subtype $name => as '$conf->{class}'?";
-        subtype $name => (as => $conf->{class});
+        subtype $name => (
+            as => $conf->{class},
+            caller_level => (($conf->{_caller_level}||0) + 1),
+        );
     }
     else {
         subtype $name => (
             where => sub { blessed($_) && $_->isa($name) },
+            caller_level => (($conf->{_caller_level}||0) + 1),
         );
     }
 }
@@ -232,6 +236,7 @@ sub role_type {
     my $role = $conf->{role};
     subtype $name => (
         where => sub { does_role($_, $role) },
+        caller_level => (($conf->{_caller_level}||0) + 1),
     );
 }
 
@@ -270,8 +275,9 @@ sub enum {
     my $name = shift;
     my %is_valid = map { $_ => 1 } @_;
 
-    subtype(
-        $name => where => sub { $is_valid{$_} }
+    subtype $name => (
+        where => sub { $is_valid{$_} },
+        _caller_level => 1,
     );
 }