2 use warnings FATAL => 'all';
4 use Test::More tests => 33;
6 use Test::Deep '!blessed';
7 use Test::NoWarnings 1.04 ':early';
8 use Scalar::Util 'blessed';
15 # nothing special going on here
19 with 'MooseX::ConfigFromFile';
20 sub get_config_from_file
22 my ($class, $file) = @_;
23 $loaded_file{$file}++;
26 around BUILDARGS => sub {
27 my ($orig, $class) = (shift, shift);
28 my $args = $class->$orig(@_);
29 $constructor_args{$class} = $args;
33 my $class = blessed($_[0]) || $_[0];
34 $configfile_sub{$class}++;
41 my $obj = Generic->new_with_config;
42 is($obj->configfile, undef, 'no configfile set');
43 cmp_deeply(\%loaded_file, {}, 'no files loaded');
45 $constructor_args{blessed($obj)},
47 'correct constructor args passed',
55 # this is a classic legacy usecase from old documentation that we must
58 package OverriddenDefault;
61 has '+configfile' => (
62 default => 'OverriddenDefault file',
68 my $obj = OverriddenDefault->new_with_config;
69 is($obj->configfile, blessed($obj) . ' file', 'configfile set via overridden default');
70 is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from');
77 package OverriddenDefaultMethod;
80 has '+configfile' => (
81 default => sub { shift->__my_configfile },
87 my $obj = OverriddenDefaultMethod->new_with_config;
88 is($obj->configfile, blessed($obj) . ' file', 'configfile set via overridden default');
89 is($configfile_sub{blessed($obj)}, 1, 'configfile was calculated just once');
90 is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from');
97 # legacy usecase, and configfile init_arg has been changed
99 package OverriddenDefaultAndChangedName;
102 has '+configfile' => (
103 init_arg => 'my_configfile',
104 default => 'OverriddenDefaultAndChangedName file',
110 my $obj = OverriddenDefaultAndChangedName->new_with_config;
111 is($obj->configfile, blessed($obj) . ' file', 'configfile set via overridden default');
113 $constructor_args{blessed($obj)},
114 { my_configfile => blessed($obj) . ' file' },
115 'correct constructor args passed',
117 is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from');
123 # "reader" method is overridden to provide for configfile default
125 package OverriddenMethod;
128 around configfile => sub { my $orig = shift; shift->__my_configfile };
133 my $obj = OverriddenMethod->new_with_config;
134 is($obj->configfile, blessed($obj) . ' file', 'configfile set via overridden sub');
135 # this is not fixable - the reader method has been shadowed
136 # is($configfile_sub{blessed($obj)}, 1, 'configfile was calculated just once');
137 is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from');
144 # overridable method for configfile default, and configfile init_arg is changed
146 package OverriddenMethodAndChangedName;
149 has '+configfile' => (
150 init_arg => 'my_configfile',
152 around configfile => sub { my $orig = shift; shift->__my_configfile };
157 my $obj = OverriddenMethodAndChangedName->new_with_config;
158 is($obj->configfile, blessed($obj) . ' file', 'configfile set via overridden sub');
160 $constructor_args{blessed($obj)},
161 { my_configfile => blessed($obj) . ' file' },
162 'correct constructor args passed',
164 # this is not fixable - the reader method has been shadowed
165 # is($configfile_sub{blessed($obj)}, 1, 'configfile was calculated just once');
166 is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from');
172 # newly-supported overridable method for configfile default
177 sub _get_default_configfile { shift->__my_configfile }
182 my $obj = NewSub->new_with_config;
183 is($obj->configfile, blessed($obj) . ' file', 'configfile set via new sub');
185 $constructor_args{blessed($obj)},
186 { configfile => blessed($obj) . ' file' },
187 'correct constructor args passed',
189 is($configfile_sub{blessed($obj)}, 1, 'configfile was calculated just once');
190 is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from');
196 # newly-supported overridable method for configfile default, and configfile
197 # init_arg has been changed
199 package NewSubAndChangedName;
202 has '+configfile' => (
203 init_arg => 'my_configfile',
205 sub _get_default_configfile { shift->__my_configfile }
210 my $obj = NewSubAndChangedName->new_with_config;
211 is($obj->configfile, blessed($obj) . ' file', 'configfile set via overridden sub');
213 $constructor_args{blessed($obj)},
214 { my_configfile => blessed($obj) . ' file' },
215 'correct constructor args passed',
217 is($configfile_sub{blessed($obj)}, 1, 'configfile was calculated just once');
218 is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from');