package Moose::Meta::Attribute::Native::Trait;
use Moose::Role;
-use List::MoreUtils qw( any );
+use List::MoreUtils qw( any uniq );
use Moose::Util::TypeConstraints;
use Moose::Deprecated;
requires '_helper_type';
+has _used_default_is => (
+ is => 'rw',
+ isa => 'Bool',
+ default => 0,
+);
+
before '_process_options' => sub {
my ( $self, $name, $options ) = @_;
$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 (
}
};
+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 ) = @_;
'Test::Output' => '0.01',
};
+# All tests are wrapped with lives_and because the stderr output tests will
+# otherwies eat exceptions, and the test just dies silently.
+
{
package Role;
use Moose;
- ::stderr_like{ has foo => (
- traits => ['String'],
- is => 'ro',
- isa => 'Str',
- );
- }
- 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{},
- );
- }
- 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';
-
- ::stderr_like{ with 'Role' =>
- { excludes => ['thing'], alias => { thing => 'thing2' } };
+ ::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/,
+ '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/\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'
);
}
use Moose;
- ::stderr_is{ has foo => (
- traits => ['String'],
- reader => '_foo',
- isa => 'Str',
- default => q{},
- );
- } q{},
- 'Providing a reader for a String trait avoids default is warning';
-
- ::lives_and{ ::stderr_is{ has bar => (
+ ::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'],
- is => 'ro',
+ reader => '_bar',
isa => 'Str',
- builder => '_build_foo',
+ default => q{},
+ );
+
+ ::ok(
+ !Pack1->can('bar'),
+ 'no default is assigned when reader is provided'
);
- } q{},
- 'Providing a builder for a String trait avoids default default warning';
- } 'Providing a builder for a String trait does not die';
- sub _build_foo { }
+ ::stderr_is{ Pack1->new->_bar } q{},
+ 'Providing a reader for a String trait avoids default is warning';
+ }
+ );
+
+ sub _build_foo { q{} }
}
{
use Moose;
- ::stderr_is{ has foo => (
- traits => ['String'],
- writer => '_foo',
- isa => 'Str',
- default => q{},
- );
- } q{},
- 'Providing a writer for a String trait avoids default is warning';
-
- ::stderr_is{ has bar => (
- traits => ['String'],
- is => 'ro',
- isa => 'Str',
- required => 1,
- );
- } q{},
- 'Making a String trait required avoids default default warning';
-
- sub _build_foo { }
+ ::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';
+ }
+ );
}
{
use Moose;
- ::stderr_is{ has foo => (
- traits => ['String'],
- accessor => '_foo',
- isa => 'Str',
- default => q{},
- );
- } q{},
- 'Providing an accessor for a String trait avoids default is warning';
-
- ::lives_and{ ::stderr_is{ has bar => (
- traits => ['String'],
- is => 'ro',
- isa => 'Str',
- lazy_build => 1,
+ ::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'
);
- } q{},
- 'Making a String trait lazy_build avoids default default warning';
- } 'Providing lazy_build for a String trait lives';
- sub _build_bar { }
+ ::stderr_is{ Pack3->new->_bar }
+ q{},
+ 'Providing a accessor for a String trait avoids default is warning';
+ }
+ );
+
+ sub _build_foo { q{} }
}
done_testing;
projects / gitmo/Moose.git / commitdiff