Deprecate _default_is and _default_default for native traits.

[gitmo/Moose.git] / lib / Moose / Meta / Attribute / Native / Trait.pm

diff --git a/lib/Moose/Meta/Attribute/Native/Trait.pm b/lib/Moose/Meta/Attribute/Native/Trait.pm
index ee44d6d..9fa865d 100644 (file)
--- a/lib/Moose/Meta/Attribute/Native/Trait.pm
+++ b/lib/Moose/Meta/Attribute/Native/Trait.pm
@@ -2,8 +2,9 @@
 package Moose::Meta::Attribute::Native::Trait;
 use Moose::Role;
 use Moose::Util::TypeConstraints;
+use Moose::Deprecated;
 
-our $VERSION   = '1.14';
+our $VERSION   = '1.15';
 $VERSION = eval $VERSION;
 our $AUTHORITY = 'cpan:STEVAN';
 
@@ -14,11 +15,25 @@ before '_process_options' => sub {
 
     $self->_check_helper_type( $options, $name );
 
-    $options->{is} = $self->_default_is
-        if !exists $options->{is} && $self->can('_default_is');
+    if ( !exists $options->{is} && $self->can('_default_is') ) {
+        $options->{is} = $self->_default_is;
 
-    $options->{default} = $self->_default_default
-        if !exists $options->{default} && $self->can('_default_default');
+        Moose::Deprecated::deprecated(
+            feature => 'default is for Native Trait',
+            message =>
+                q{Allowing a native trait to automatically supply a value for "is" is deprecated}
+        );
+    }
+
+    if ( !exists $options->{default} && $self->can('_default_default') ) {
+        $options->{default} = $self->_default_default;
+
+        Moose::Deprecated::deprecated(
+            feature => 'default default for Native Trait',
+            message =>
+                'Allowing a native trait to automatically supply a default is deprecated'
+        );
+    }
 };
 
 sub _check_helper_type {
@@ -86,12 +101,13 @@ around '_make_delegation_method' => sub {
         unless $accessor_class && $accessor_class->can('new');
 
     return $accessor_class->new(
-        name              => $handle_name,
-        package_name      => $self->associated_class->name,
-        attribute         => $self,
-        is_inline         => 1,
-        curried_arguments => \@curried_args,
-        root_types        => [ $self->_root_types ],
+        name               => $handle_name,
+        package_name       => $self->associated_class->name,
+        delegate_to_method => $name,
+        attribute          => $self,
+        is_inline          => 1,
+        curried_arguments  => \@curried_args,
+        root_types         => [ $self->_root_types ],
     );
 };
 
@@ -102,7 +118,17 @@ sub _root_types {
 sub _native_accessor_class_for {
     my ( $self, $suffix ) = @_;
 
-    return 'Moose::Meta::Method::Accessor::Native::' . $self->_native_type . '::' . $suffix;
+    my $role
+        = 'Moose::Meta::Method::Accessor::Native::'
+        . $self->_native_type . '::'
+        . $suffix;
+
+    return Moose::Meta::Class->create_anon_class(
+        superclasses =>
+            [ $self->accessor_metaclass, $self->delegation_metaclass ],
+        roles => [$role],
+        cache => 1,
+    )->name;
 }
 
 sub _build_native_type {