use strict;
-use warnings;
+use warnings FATAL => 'all';
-use Test::More tests => 10;
+use Test::More;
use Test::Fatal;
use Test::Deep '!blessed';
-use Test::NoWarnings 1.04 ':early';
+use if $ENV{AUTHOR_TESTING}, 'Test::Warnings';
use Scalar::Util 'blessed';
my %loaded_file;
-my %default_sub;
+my %configfile_sub;
+my %constructor_args;
# nothing special going on here
{
package Generic;
use Moose;
- with 'MooseX::SimpleConfig';
- sub get_config_from_file { }
+ with 'MooseX::ConfigFromFile';
+ sub get_config_from_file
+ {
+ my ($class, $file) = @_;
+ $loaded_file{$file}++;
+ +{}
+ }
+ around BUILDARGS => sub {
+ my ($orig, $class) = (shift, shift);
+ my $args = $class->$orig(@_);
+ $constructor_args{$class} = $args;
+ };
+ sub __my_configfile
+ {
+ my $class = blessed($_[0]) || $_[0];
+ $configfile_sub{$class}++;
+ $class . ' file'
+ }
}
is(
exception {
my $obj = Generic->new_with_config;
is($obj->configfile, undef, 'no configfile set');
+ cmp_deeply(\%loaded_file, {}, 'no files loaded');
+ cmp_deeply(
+ $constructor_args{blessed($obj)},
+ { },
+ 'correct constructor args passed',
+ );
},
undef,
'no exceptions',
);
-
-# this is a classic legacy usecase from old documentation that we must
-# continue to support
{
- package OverriddenDefault;
+ package Base;
use Moose;
- with 'MooseX::SimpleConfig';
+}
+{
+ package GenericRole;
+ use Moose::Role;
+ with 'MooseX::ConfigFromFile';
sub get_config_from_file
{
my ($class, $file) = @_;
$loaded_file{$file}++;
+{}
}
+ around BUILDARGS => sub {
+ my ($orig, $class) = (shift, shift);
+ my $args = $class->$orig(@_);
+ $constructor_args{$class} = $args;
+ };
+ sub __my_configfile
+ {
+ my $class = blessed($_[0]) || $_[0];
+ $configfile_sub{$class}++;
+ $class . ' file'
+ }
+}
+
+is(
+ exception {
+ my $obj = Moose::Meta::Class->create_anon_class(
+ superclasses => ['Base'],
+ roles => ['GenericRole'],
+ )->name->new_with_config;
+ is($obj->configfile, undef, 'no configfile set');
+ cmp_deeply(\%loaded_file, {}, 'no files loaded');
+ cmp_deeply(
+ $constructor_args{blessed($obj)},
+ { },
+ 'correct constructor args passed',
+ );
+ },
+ undef,
+ 'no exceptions',
+);
+
+# this is a classic legacy usecase from old documentation that we must
+# continue to support
+{
+ package OverriddenDefault;
+ use Moose;
+ extends 'Generic';
has '+configfile' => (
default => 'OverriddenDefault file',
);
'no exceptions',
);
+{
+ package OverriddenDefaultMethod;
+ use Moose;
+ extends 'Generic';
+ has '+configfile' => (
+ default => sub { shift->__my_configfile },
+ );
+}
+
+is(
+ exception {
+ my $obj = OverriddenDefaultMethod->new_with_config;
+ is($obj->configfile, blessed($obj) . ' file', 'configfile set via overridden default');
+ is($configfile_sub{blessed($obj)}, 1, 'configfile was calculated just once');
+ is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from');
+ },
+ undef,
+ 'no exceptions',
+);
+
+
+# legacy usecase, and configfile init_arg has been changed
+{
+ package OverriddenDefaultAndChangedName;
+ use Moose;
+ extends 'Generic';
+ has '+configfile' => (
+ init_arg => 'my_configfile',
+ default => 'OverriddenDefaultAndChangedName file',
+ );
+}
+
+is(
+ exception {
+ my $obj = OverriddenDefaultAndChangedName->new_with_config;
+ is($obj->configfile, blessed($obj) . ' file', 'configfile set via overridden default');
+ cmp_deeply(
+ $constructor_args{blessed($obj)},
+ { my_configfile => blessed($obj) . ' file' },
+ 'correct constructor args passed',
+ );
+ is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from');
+ },
+ undef,
+ 'no exceptions',
+);
# "reader" method is overridden to provide for configfile default
{
package OverriddenMethod;
use Moose;
- with 'MooseX::SimpleConfig';
- sub get_config_from_file {
- my ($class, $file) = @_;
- $loaded_file{$file}++;
- +{}
- }
-
- around configfile => sub {
- my $class = blessed($_[1]) || $_[1];
- $default_sub{$class}++;
- $class . ' file'
- };
+ extends 'Generic';
+ around configfile => sub { my $orig = shift; shift->__my_configfile };
}
is(
exception {
my $obj = OverriddenMethod->new_with_config;
is($obj->configfile, blessed($obj) . ' file', 'configfile set via overridden sub');
- ok($default_sub{blessed($obj)}, 'default sub was called');
+ # this is not fixable - the reader method has been shadowed
+ # is($configfile_sub{blessed($obj)}, 1, 'configfile was calculated just once');
is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from');
},
undef,
'no exceptions',
);
+{
+ package OverriddenMethodAsRole;
+ use Moose::Role;
+ with 'GenericRole';
+ around configfile => sub { my $orig = shift; shift->__my_configfile };
+}
+
+is(
+ exception {
+ my $obj = Moose::Meta::Class->create_anon_class(
+ superclasses => ['Base'],
+ roles => ['OverriddenMethodAsRole'],
+ )->name->new_with_config;
+ is($obj->configfile, blessed($obj) . ' file', 'configfile set via overridden sub');
+ # this is not fixable - the reader method has been shadowed
+ # is($configfile_sub{blessed($obj)}, 1, 'configfile was calculated just once');
+ is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from');
+ },
+ undef,
+ 'no exceptions',
+);
+
+
+# overridable method for configfile default, and configfile init_arg is changed
+{
+ package OverriddenMethodAndChangedName;
+ use Moose;
+ extends 'Generic';
+ has '+configfile' => (
+ init_arg => 'my_configfile',
+ );
+ around configfile => sub { my $orig = shift; shift->__my_configfile };
+}
+
+is(
+ exception {
+ my $obj = OverriddenMethodAndChangedName->new_with_config;
+ is($obj->configfile, blessed($obj) . ' file', 'configfile set via overridden sub');
+ cmp_deeply(
+ $constructor_args{blessed($obj)},
+ { my_configfile => blessed($obj) . ' file' },
+ 'correct constructor args passed',
+ );
+ # this is not fixable - the reader method has been shadowed
+ # is($configfile_sub{blessed($obj)}, 1, 'configfile was calculated just once');
+ is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from');
+ },
+ undef,
+ 'no exceptions',
+);
+
+{
+ package OverriddenMethodAndChangedNameAsRole;
+ use Moose::Role;
+ with 'GenericRole';
+ use MooseX::Types::Path::Tiny 'Path';
+ use MooseX::Types::Moose 'Undef';
+ use Try::Tiny;
+ has configfile => (
+ is => 'ro',
+ isa => Path|Undef,
+ coerce => 1,
+ predicate => 'has_configfile',
+ do { try { require MooseX::Getopt; (traits => ['Getopt']) } },
+ lazy => 1,
+ # it sucks that we have to do this rather than using a builder, but some old code
+ # simply swaps in a new default sub into the attr definition
+ default => sub { shift->_get_default_configfile },
+
+ # this is the overridden bit
+ init_arg => 'my_configfile',
+ );
+ around configfile => sub { my $orig = shift; shift->__my_configfile };
+}
+
+is(
+ exception {
+ my $obj = Moose::Meta::Class->create_anon_class(
+ superclasses => ['Base'],
+ roles => ['OverriddenMethodAndChangedNameAsRole'],
+ )->name->new_with_config;
+ is($obj->configfile, blessed($obj) . ' file', 'configfile set via overridden sub');
+ cmp_deeply(
+ $constructor_args{blessed($obj)},
+ { my_configfile => blessed($obj) . ' file' },
+ 'correct constructor args passed',
+ );
+ # this is not fixable - the reader method has been shadowed
+ # is($configfile_sub{blessed($obj)}, 1, 'configfile was calculated just once');
+ is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from');
+ },
+ undef,
+ 'no exceptions',
+);
+
+
+# newly-supported overridable method for configfile default
+{
+ package NewSub;
+ use Moose;
+ extends 'Generic';
+ sub _get_default_configfile { shift->__my_configfile }
+}
+
+is(
+ exception {
+ my $obj = NewSub->new_with_config;
+ is($obj->configfile, blessed($obj) . ' file', 'configfile set via new sub');
+ cmp_deeply(
+ $constructor_args{blessed($obj)},
+ { configfile => blessed($obj) . ' file' },
+ 'correct constructor args passed',
+ );
+ is($configfile_sub{blessed($obj)}, 1, 'configfile was calculated just once');
+ is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from');
+ },
+ undef,
+ 'no exceptions',
+);
+
+{
+ package NewSubAsRole;
+ use Moose::Role;
+ with 'GenericRole';
+ sub _get_default_configfile { shift->__my_configfile }
+}
+
+is(
+ exception {
+ my $obj = Moose::Meta::Class->create_anon_class(
+ superclasses => ['Base'],
+ roles => ['NewSubAsRole'],
+ )->name->new_with_config;
+ is($obj->configfile, blessed($obj) . ' file', 'configfile set via new sub');
+ cmp_deeply(
+ $constructor_args{blessed($obj)},
+ { configfile => blessed($obj) . ' file' },
+ 'correct constructor args passed',
+ );
+ is($configfile_sub{blessed($obj)}, 1, 'configfile was calculated just once');
+ is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from');
+ },
+ undef,
+ 'no exceptions',
+);
+
+
+# newly-supported overridable method for configfile default, and configfile
+# init_arg has been changed
+{
+ package NewSubAndChangedName;
+ use Moose;
+ extends 'Generic';
+ has '+configfile' => (
+ init_arg => 'my_configfile',
+ );
+ sub _get_default_configfile { shift->__my_configfile }
+}
+
+is(
+ exception {
+ my $obj = NewSubAndChangedName->new_with_config;
+ is($obj->configfile, blessed($obj) . ' file', 'configfile set via overridden sub');
+ cmp_deeply(
+ $constructor_args{blessed($obj)},
+ { my_configfile => blessed($obj) . ' file' },
+ 'correct constructor args passed',
+ );
+ is($configfile_sub{blessed($obj)}, 1, 'configfile was calculated just once');
+ is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from');
+ },
+ undef,
+ 'no exceptions',
+);
+done_testing;