Commit | Line | Data |
004c25dc |
1 | use strict; |
2 | use warnings; |
3 | |
4 | use Test::More tests => 20; |
5 | use Test::Fatal; |
6 | use Test::Deep '!blessed'; |
7 | use Test::NoWarnings 1.04 ':early'; |
8 | use Scalar::Util 'blessed'; |
9 | |
10 | my %loaded_file; |
11 | my %constructor_args; |
12 | my %default_sub; |
13 | |
14 | |
15 | # nothing special going on here |
16 | { |
17 | package Generic; |
18 | use Moose; |
19 | with 'MooseX::SimpleConfig'; |
20 | sub get_config_from_file { } |
21 | } |
22 | |
23 | is( |
24 | exception { |
25 | my $obj = Generic->new_with_config; |
26 | is($obj->configfile, undef, 'no configfile set'); |
27 | }, |
28 | undef, |
29 | 'no exceptions', |
30 | ); |
31 | |
32 | |
33 | # this is a classic legacy usecase that we must continue to support |
34 | { |
35 | package OverriddenDefault; |
36 | use Moose; |
37 | with 'MooseX::SimpleConfig'; |
38 | sub get_config_from_file |
39 | { |
40 | my ($class, $file) = @_; |
41 | $loaded_file{$file}++; |
42 | +{} |
43 | } |
44 | has '+configfile' => ( |
45 | default => 'OverriddenDefault file', |
46 | ); |
47 | } |
48 | |
49 | is( |
50 | exception { |
51 | my $obj = OverriddenDefault->new_with_config; |
52 | is($obj->configfile, 'OverriddenDefault file', 'configfile set via overridden default'); |
53 | is($loaded_file{'OverriddenDefault file'}, 1, 'correct file was loaded from'); |
54 | }, |
55 | undef, |
56 | 'no exceptions', |
57 | ); |
58 | |
59 | |
60 | # legacy usecase, and configfile init_arg has been changed |
61 | { |
62 | package OverriddenDefaultAndChangedName; |
63 | use Moose; |
64 | with 'MooseX::SimpleConfig'; |
65 | sub get_config_from_file |
66 | { |
67 | my ($class, $file) = @_; |
68 | $loaded_file{$file}++; |
69 | +{} |
70 | } |
71 | has '+configfile' => ( |
72 | init_arg => 'my_configfile', |
73 | default => 'OverriddenDefaultAndChangedName file', |
74 | ); |
75 | around BUILDARGS => sub { |
76 | my ($orig, $class) = (shift, shift); |
77 | my $args = $class->$orig(@_); |
78 | $constructor_args{$class} = $args; |
79 | }; |
80 | } |
81 | |
82 | is( |
83 | exception { |
84 | my $obj = OverriddenDefaultAndChangedName->new_with_config; |
85 | is($obj->configfile, blessed($obj) . ' file', 'configfile set via overridden default'); |
86 | cmp_deeply( |
87 | $constructor_args{blessed($obj)}, |
88 | { my_configfile => blessed($obj) . ' file' }, |
89 | 'correct constructor args passed', |
90 | ); |
91 | is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from'); |
92 | }, |
93 | undef, |
94 | 'no exceptions', |
95 | ); |
96 | |
97 | |
98 | # newly-supported overridable method for configfile default |
99 | { |
100 | package WrapperSub; |
101 | use Moose; |
102 | with 'MooseX::SimpleConfig'; |
103 | sub get_config_from_file |
104 | { |
105 | my ($class, $file) = @_; |
106 | $loaded_file{$file}++; |
107 | +{} |
108 | } |
109 | |
110 | sub _get_default_configfile { |
111 | my $class = shift; |
112 | $default_sub{$class}++; |
113 | $class . ' file' |
114 | } |
115 | |
116 | around BUILDARGS => sub { |
117 | my ($orig, $class) = (shift, shift); |
118 | my $args = $class->$orig(@_); |
119 | $constructor_args{$class} = $args; |
120 | }; |
121 | } |
122 | |
123 | is( |
124 | exception { |
125 | my $obj = WrapperSub->new_with_config; |
126 | is($obj->configfile, blessed($obj) . ' file', 'configfile set via overridden sub'); |
127 | cmp_deeply( |
128 | $constructor_args{blessed($obj)}, |
129 | { configfile => blessed($obj) . ' file' }, |
130 | 'correct constructor args passed', |
131 | ); |
132 | is($default_sub{blessed($obj)}, 1, 'default sub called just once'); |
133 | is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from'); |
134 | }, |
135 | undef, |
136 | 'no exceptions', |
137 | ); |
138 | |
139 | |
140 | # newly-supported overridable method for configfile default, and configfile |
141 | # init_arg has been changed |
142 | { |
143 | package WrapperSubAndChangedName; |
144 | use Moose; |
145 | with 'MooseX::SimpleConfig'; |
146 | has '+configfile' => ( |
147 | init_arg => 'my_configfile', |
148 | ); |
149 | sub get_config_from_file |
150 | { |
151 | my ($class, $file) = @_; |
152 | $loaded_file{$file}++; |
153 | +{} |
154 | } |
155 | |
156 | sub _get_default_configfile { |
157 | my $class = shift; |
158 | $default_sub{$class}++; |
159 | $class . ' file' |
160 | } |
161 | |
162 | around BUILDARGS => sub { |
163 | my ($orig, $class) = (shift, shift); |
164 | my $args = $class->$orig(@_); |
165 | $constructor_args{$class} = $args; |
166 | }; |
167 | } |
168 | |
169 | is( |
170 | exception { |
171 | my $obj = WrapperSubAndChangedName->new_with_config; |
172 | is($obj->configfile, blessed($obj) . ' file', 'configfile set via overridden sub'); |
173 | cmp_deeply( |
174 | $constructor_args{blessed($obj)}, |
175 | { my_configfile => blessed($obj) . ' file' }, |
176 | 'correct constructor args passed', |
177 | ); |
178 | is($default_sub{blessed($obj)}, 1, 'default sub called just once'); |
179 | is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from'); |
180 | }, |
181 | undef, |
182 | 'no exceptions', |
183 | ); |
184 | |