use MooseX::UndefTolerant::Constructor;
-my %metaroles = ( attribute => [ 'MooseX::UndefTolerant::Attribute' ] );
+my %metaroles = (
+ class_metaroles => {
+ attribute => [ 'MooseX::UndefTolerant::Attribute' ],
+ }
+);
if ( $Moose::VERSION < 1.9900 ) {
- $metaroles{constructor} = [ 'MooseX::UndefTolerant::Constructor' ];
+ $metaroles{class_metaroles}{constructor} = [
+ 'MooseX::UndefTolerant::Constructor',
+ ];
}
else {
- $metaroles{class} = [ 'MooseX::UndefTolerant::Class' ];
+ $metaroles{class_metaroles}{class} = [
+ 'MooseX::UndefTolerant::Class',
+ ];
+ $metaroles{role_metaroles} = {
+ applied_attribute => [
+ 'MooseX::UndefTolerant::Attribute',
+ ],
+ role => [
+ 'MooseX::UndefTolerant::Role',
+ ],
+ application_to_class => [
+ 'MooseX::UndefTolerant::ApplicationToClass',
+ ],
+ application_to_role => [
+ 'MooseX::UndefTolerant::ApplicationToRole',
+ ],
+ };
}
-Moose::Exporter->setup_import_methods(
- class_metaroles => \%metaroles,
-);
+Moose::Exporter->setup_import_methods(%metaroles);
1;
--- /dev/null
+package MooseX::UndefTolerant::ApplicationToClass;
+use Moose::Role;
+
+around apply => sub {
+ my $orig = shift;
+ my $self = shift;
+ my ($role, $class) = @_;
+
+ Moose::Util::MetaRole::apply_metaroles(
+ for => $class,
+ class_metaroles => {
+ class => [ 'MooseX::UndefTolerant::Class' ],
+ }
+ );
+
+ $self->$orig( $role, $class );
+};
+
+no Moose::Role;
+
+1;
--- /dev/null
+package MooseX::UndefTolerant::ApplicationToRole;
+use Moose::Role;
+
+around apply => sub {
+ my $orig = shift;
+ my $self = shift;
+ my ($role, $class) = @_;
+
+ Moose::Util::MetaRole::apply_metaroles(
+ for => $class,
+ role_metaroles => {
+ application_to_class => [
+ 'MooseX::UndefTolerant::ApplicationToClass',
+ ],
+ application_to_role => [
+ 'MooseX::UndefTolerant::ApplicationToRole',
+ ],
+ }
+ );
+
+ $self->$orig( $role, $class );
+};
+
+no Moose::Role;
+
+1;
--- /dev/null
+package MooseX::UndefTolerant::Composite;
+use Moose::Role;
+
+around apply_params => sub {
+ my $orig = shift;
+ my $self = shift;
+
+ $self->$orig(@_);
+
+ $self = Moose::Util::MetaRole::apply_metaroles(
+ for => $self,
+ role_metaroles => {
+ application_to_class =>
+ ['MooseX::UndefTolerant::ApplicationToClass'],
+ application_to_role =>
+ ['MooseX::UndefTolerant::ApplicationToRole'],
+ },
+ );
+
+ return $self;
+};
+
+no Moose::Role;
+
+1;
--- /dev/null
+package MooseX::UndefTolerant::Role;
+use Moose::Role;
+
+sub composition_class_roles { 'MooseX::UndefTolerant::Composite' }
+
+no Moose::Role;
+
+1;
--- /dev/null
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+use Test::Moose;
+use Test::Fatal;
+
+plan skip_all => "only relevant for Moose 2.0"
+ if Moose->VERSION < 1.9900;
+
+{
+ package Foo::Role;
+ use Moose::Role;
+ use MooseX::UndefTolerant;
+
+ has foo => (
+ is => 'ro',
+ isa => 'Str',
+ predicate => 'has_foo',
+ );
+}
+
+{
+ package Foo;
+ use Moose;
+
+ with 'Foo::Role';
+}
+
+{
+ package Bar::Role;
+ use Moose::Role;
+}
+
+{
+ package Bar;
+ use Moose;
+
+ with 'Foo::Role', 'Bar::Role';
+}
+
+with_immutable {
+ my $foo;
+ is(exception { $foo = Foo->new(foo => undef) }, undef,
+ "can set to undef in constructor");
+ ok(!$foo->has_foo, "role attribute isn't set");
+
+ my $bar;
+ is(exception { $bar = Bar->new(foo => undef) }, undef,
+ "can set to undef in constructor");
+ ok(!$bar->has_foo, "role attribute isn't set");
+} 'Foo', 'Bar';
+
+done_testing;