Merge branch 'rfc/new-warns-on-odd'
Dave Rolsky [Sun, 17 Oct 2010 20:46:18 +0000 (15:46 -0500)]
Changes
Makefile.PL
lib/Moose/Deprecated.pm
lib/Moose/Exporter.pm
lib/Moose/Meta/Attribute/Native/Trait.pm
t/010_basics/030_deprecations.t

diff --git a/Changes b/Changes
index 6ea77d8..8cbf7e8 100644 (file)
--- a/Changes
+++ b/Changes
@@ -35,6 +35,24 @@ NEXT
     something that can be assigned to). This should fix issues with
     KiokuDB::Class. (doy)
 
+  * We now ignore all Class::MOP and Moose classes when determining what
+    package called a deprecated feature. This should make the deprecation
+    warnings saner, and make it possible to turn them off more easily. (Dave
+    Rolsky)
+
+  * The deprecated "default is" warning no longer happens if the attribute has
+    any accessor method defined (accessor, reader, writer). Also, this warning
+    only happens when a method that was generated because of the "default is"
+    gets called, rather than when the attribute is defined. (Dave Rolsky)
+
+  * The "default default" code for some native delegations no longer issues a
+    deprecation warning when the attribute is required or has a builder. (Dave
+    Rolsky)
+
+  * Setting a "default default" caused a fatal error if you used the builder
+    or lazy_build options for the attribute. Reported by Kent Fredric. RT
+    #59613. (Dave Rolsky)
+
 1.15 Tue, Oct 5, 2010
 
   [API CHANGES]
index 524daf0..2f73418 100644 (file)
@@ -17,7 +17,7 @@ requires 'Carp';
 requires 'Class::MOP'                  => '1.10';
 requires 'Data::OptList'               => '0';
 requires 'List::MoreUtils'             => '0.12';
-requires 'Package::DeprecationManager' => '0.04';
+requires 'Package::DeprecationManager' => '0.07';
 requires 'Params::Util'                => '1.00';
 requires 'Scalar::Util'                => '1.19';
 requires 'Sub::Exporter'               => '0.980';
index d3725a2..9914f74 100644 (file)
@@ -7,7 +7,7 @@ our $VERSION = '1.15';
 $VERSION = eval $VERSION;
 our $AUTHORITY = 'cpan:STEVAN';
 
-use Package::DeprecationManager -deprecations => {
+use Package::DeprecationManager 0.07 -deprecations => {
     'default is for Native Trait'      => '1.14',
     'default default for Native Trait' => '1.14',
     'coerce without coercion'          => '1.08',
@@ -18,14 +18,7 @@ use Package::DeprecationManager -deprecations => {
     'type without sugar'               => '0.72',
     'Moose::init_meta'                 => '0.56',
     },
-    -ignore => [
-    qw( Moose
-        Moose::Exporter
-        Moose::Meta::Attribute
-        Moose::Meta::Class
-        Moose::Util::MetaRole
-        )
-    ],
+    -ignore => [qr/^(?:Class::MOP|Moose)(?:::)?/],
     ;
 
 1;
index c7b71d1..fefd681 100644 (file)
@@ -10,7 +10,6 @@ our $AUTHORITY = 'cpan:STEVAN';
 
 use Class::MOP;
 use List::MoreUtils qw( first_index uniq );
-use Moose::Deprecated;
 use Moose::Util::MetaRole;
 use Scalar::Util qw(reftype);
 use Sub::Exporter 0.980;
index a44b7dd..de59416 100644 (file)
@@ -1,6 +1,8 @@
 
 package Moose::Meta::Attribute::Native::Trait;
 use Moose::Role;
+
+use List::MoreUtils qw( any uniq );
 use Moose::Util::TypeConstraints;
 use Moose::Deprecated;
 
@@ -10,32 +12,76 @@ our $AUTHORITY = 'cpan:STEVAN';
 
 requires '_helper_type';
 
+has _used_default_is => (
+    is      => 'rw',
+    isa     => 'Bool',
+    default => 0,
+);
+
 before '_process_options' => sub {
     my ( $self, $name, $options ) = @_;
 
     $self->_check_helper_type( $options, $name );
 
-    if ( !exists $options->{is} && $self->can('_default_is') ) {
+    if ( !( any { exists $options->{$_} } qw( is reader writer accessor ) )
+        && $self->can('_default_is') ) {
+
         $options->{is} = $self->_default_is;
 
-        Moose::Deprecated::deprecated(
-            feature => 'default is for Native Trait',
-            message =>
-                q{Allowing a native trait to automatically supply a value for "is" is deprecated}
-        );
+        $options->{_used_default_is} = 1;
     }
 
-    if ( !exists $options->{default} && $self->can('_default_default') ) {
+    if (
+        !(
+            $options->{required}
+            || any { exists $options->{$_} } qw( default builder lazy_build )
+        )
+        && $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'
+                'Allowing a native trait to automatically supply a default is deprecated.'
+                . ' You can avoid this warning by supply a default, builder, or making the attribute required'
         );
     }
 };
 
+after 'install_accessors' => sub {
+    my $self = shift;
+
+    return unless $self->_used_default_is;
+
+    my @methods
+        = $self->_default_is eq 'rw'
+        ? qw( reader writer accessor )
+        : 'reader';
+
+    my $name = $self->name;
+    my $class = $self->associated_class->name;
+
+    for my $meth ( uniq grep {defined} map { $self->$_ } @methods ) {
+
+        my $message
+            = "The $meth method in the $class class was automatically created"
+            . " by the native delegation trait for the $name attribute."
+            . q{ This "default is" feature is deprecated.}
+            . q{ Explicitly set "is" or define accessor names to avoid this};
+
+        $self->associated_class->add_before_method_modifier(
+            $meth => sub {
+                Moose::Deprecated::deprecated(
+                    feature => 'default is for Native Trait',
+                    message =>$message,
+                );
+            }
+        );
+    }
+    };
+
 sub _check_helper_type {
     my ( $self, $options, $name ) = @_;
 
index 211e6df..d4d4004 100644 (file)
@@ -1,12 +1,16 @@
 use strict;
 use warnings;
 
+use Test::Exception;
 use Test::More;
 
 use Test::Requires {
     'Test::Output' => '0.01',
 };
 
+# All tests are wrapped with lives_and because the stderr output tests will
+# otherwise eat exceptions, and the test just dies silently.
+
 {
     package Role;
 
@@ -20,37 +24,151 @@ use Test::Requires {
 
     use Moose;
 
-    ::stderr_like{ has foo => (
-            traits => ['String'],
-            is     => 'ro',
-            isa    => 'Str',
-        );
+    ::lives_and(
+        sub {
+            ::stderr_like{ has foo => (
+                    traits => ['String'],
+                    is     => 'ro',
+                    isa    => 'Str',
+                );
+                }
+                qr{\QAllowing a native trait to automatically supply a default is deprecated. You can avoid this warning by supply a default, builder, or making the attribute required at t/010_basics/030_deprecations.t line},
+                'Not providing a default for native String trait warns';
+
+            ::stderr_is{ has bar => (
+                    traits  => ['Bool'],
+                    isa     => 'Bool',
+                    default => q{},
+                );
+                } q{}, 'No warning when _default_is is set';
+
+            ::stderr_like{ Foo->new->bar }
+                qr{\QThe bar method in the Foo class was automatically created by the native delegation trait for the bar attribute. This "default is" feature is deprecated. Explicitly set "is" or define accessor names to avoid this at t/010_basics/030_deprecations.t line},
+                'calling a reader on a method created by a _default_is warns';
+
+            ::stderr_like{ with 'Role' =>
+                    { excludes => ['thing'], alias => { thing => 'thing2' } };
+                }
+                qr/\QThe alias and excludes options for role application have been renamed -alias and -excludes/,
+                'passing excludes or alias with a leading dash warns';
+            ::ok(
+                !Foo->meta->has_method('thing'),
+                'thing method is excluded from role application'
+            );
+            ::ok(
+                Foo->meta->has_method('thing2'),
+                'thing2 method is created as alias in role application'
+            );
         }
-        qr/\QAllowing a native trait to automatically supply a default is deprecated/,
-        'Not providing a default for native String trait warns';
-
-    ::stderr_like{ has bar => (
-            traits  => ['String'],
-            isa     => 'Str',
-            default => q{},
-        );
+    );
+}
+
+{
+    package Pack1;
+
+    use Moose;
+
+    ::lives_and(
+        sub {
+            ::stderr_is{ has foo => (
+                    traits  => ['String'],
+                    is      => 'ro',
+                    isa     => 'Str',
+                    builder => '_build_foo',
+                );
+                } q{},
+                'Providing a builder for a String trait avoids default default warning';
+
+            has bar => (
+                traits  => ['String'],
+                reader  => '_bar',
+                isa     => 'Str',
+                default => q{},
+            );
+
+            ::ok(
+                !Pack1->can('bar'),
+                'no default is assigned when reader is provided'
+            );
+
+            ::stderr_is{ Pack1->new->_bar } q{},
+                'Providing a reader for a String trait avoids default is warning';
         }
-        qr/\QAllowing a native trait to automatically supply a value for "is" is deprecated/,
-        'Not providing a value for is with native String trait warns';
+    );
+
+    sub _build_foo { q{} }
+}
 
-    ::stderr_like{ with 'Role' =>
-            { excludes => ['thing'], alias => { thing => 'thing2' } };
+{
+    package Pack2;
+
+    use Moose;
+
+    ::lives_and(
+        sub {
+            ::stderr_is{ has foo => (
+                    traits   => ['String'],
+                    is       => 'ro',
+                    isa      => 'Str',
+                    required => 1,
+                );
+                } q{},
+                'Making a String trait required avoids default default warning';
+
+            has bar => (
+                traits  => ['String'],
+                writer  => '_bar',
+                isa     => 'Str',
+                default => q{},
+            );
+
+            ::ok(
+                !Pack2->can('bar'),
+                'no default is assigned when writer is provided'
+            );
+
+            ::stderr_is{ Pack2->new( foo => 'x' )->_bar('x') }
+                q{},
+                'Providing a writer for a String trait avoids default is warning';
         }
-        qr/\QThe alias and excludes options for role application have been renamed -alias and -excludes/,
-        'passing excludes or alias with a leading dash warns';
-    ::ok(
-        !Foo->meta->has_method('thing'),
-        'thing method is excluded from role application'
     );
-    ::ok(
-        Foo->meta->has_method('thing2'),
-        'thing2 method is created as alias in role application'
+}
+
+{
+    package Pack3;
+
+    use Moose;
+
+    ::lives_and(
+        sub {
+            ::stderr_is{ has foo => (
+                    traits     => ['String'],
+                    is         => 'ro',
+                    isa        => 'Str',
+                    lazy_build => 1,
+                );
+                } q{},
+                'Making a String trait lazy_build avoids default default warning';
+
+            has bar => (
+                traits   => ['String'],
+                accessor => '_bar',
+                isa      => 'Str',
+                default  => q{},
+            );
+
+            ::ok(
+                !Pack3->can('bar'),
+                'no default is assigned when accessor is provided'
+            );
+
+            ::stderr_is{ Pack3->new->_bar }
+                q{},
+                'Providing a accessor for a String trait avoids default is warning';
+        }
     );
+
+    sub _build_foo { q{} }
 }
 
 done_testing;