t/05_default_sub.t

   1 use strict;
   2 use warnings FATAL => 'all';
   3
   4 use Test::More tests => 49;
   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 %configfile_sub;
  12 my %constructor_args;
  13
  14
  15 # nothing special going on here
  16 {
  17     package Generic;
  18     use Moose;
  19     with 'MooseX::ConfigFromFile';
  20     sub get_config_from_file
  21     {
  22         my ($class, $file) = @_;
  23         $loaded_file{$file}++;
  24         +{}
  25     }
  26     around BUILDARGS => sub {
  27         my ($orig, $class) = (shift, shift);
  28         my $args = $class->$orig(@_);
  29         $constructor_args{$class} = $args;
  30     };
  31     sub __my_configfile
  32     {
  33         my $class = blessed($_[0]) || $_[0];
  34         $configfile_sub{$class}++;
  35         $class . ' file'
  36     }
  37 }
  38
  39 is(
  40     exception {
  41         my $obj = Generic->new_with_config;
  42         is($obj->configfile, undef, 'no configfile set');
  43         cmp_deeply(\%loaded_file, {}, 'no files loaded');
  44         cmp_deeply(
  45             $constructor_args{blessed($obj)},
  46             { },
  47             'correct constructor args passed',
  48         );
  49     },
  50     undef,
  51     'no exceptions',
  52 );
  53
  54 {
  55     package Base;
  56     use Moose;
  57 }
  58 {
  59     package GenericRole;
  60     use Moose::Role;
  61     with 'MooseX::ConfigFromFile';
  62     sub get_config_from_file
  63     {
  64         my ($class, $file) = @_;
  65         $loaded_file{$file}++;
  66         +{}
  67     }
  68     around BUILDARGS => sub {
  69         my ($orig, $class) = (shift, shift);
  70         my $args = $class->$orig(@_);
  71         $constructor_args{$class} = $args;
  72     };
  73     sub __my_configfile
  74     {
  75         my $class = blessed($_[0]) || $_[0];
  76         $configfile_sub{$class}++;
  77         $class . ' file'
  78     }
  79 }
  80
  81 is(
  82     exception {
  83         my $obj = Moose::Meta::Class->create_anon_class(
  84             superclasses => ['Base'],
  85             roles => ['GenericRole'],
  86         )->name->new_with_config;
  87         is($obj->configfile, undef, 'no configfile set');
  88         cmp_deeply(\%loaded_file, {}, 'no files loaded');
  89         cmp_deeply(
  90             $constructor_args{blessed($obj)},
  91             { },
  92             'correct constructor args passed',
  93         );
  94     },
  95     undef,
  96     'no exceptions',
  97 );
  98
  99 # this is a classic legacy usecase from old documentation that we must
 100 # continue to support
 101 {
 102     package OverriddenDefault;
 103     use Moose;
 104     extends 'Generic';
 105     has '+configfile' => (
 106         default => 'OverriddenDefault file',
 107     );
 108 }
 109
 110 is(
 111     exception {
 112         my $obj = OverriddenDefault->new_with_config;
 113         is($obj->configfile, blessed($obj) . ' file', 'configfile set via overridden default');
 114         is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from');
 115     },
 116     undef,
 117     'no exceptions',
 118 );
 119
 120 {
 121     package OverriddenDefaultMethod;
 122     use Moose;
 123     extends 'Generic';
 124     has '+configfile' => (
 125         default => sub { shift->__my_configfile },
 126     );
 127 }
 128
 129 is(
 130     exception {
 131         my $obj = OverriddenDefaultMethod->new_with_config;
 132         is($obj->configfile, blessed($obj) . ' file', 'configfile set via overridden default');
 133         is($configfile_sub{blessed($obj)}, 1, 'configfile was calculated just once');
 134         is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from');
 135     },
 136     undef,
 137     'no exceptions',
 138 );
 139
 140
 141 # legacy usecase, and configfile init_arg has been changed
 142 {
 143     package OverriddenDefaultAndChangedName;
 144     use Moose;
 145     extends 'Generic';
 146     has '+configfile' => (
 147         init_arg => 'my_configfile',
 148         default => 'OverriddenDefaultAndChangedName file',
 149     );
 150 }
 151
 152 is(
 153     exception {
 154         my $obj = OverriddenDefaultAndChangedName->new_with_config;
 155         is($obj->configfile, blessed($obj) . ' file', 'configfile set via overridden default');
 156         cmp_deeply(
 157             $constructor_args{blessed($obj)},
 158             {  my_configfile => blessed($obj) . ' file' },
 159             'correct constructor args passed',
 160         );
 161         is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from');
 162     },
 163     undef,
 164     'no exceptions',
 165 );
 166
 167 # "reader" method is overridden to provide for configfile default
 168 {
 169     package OverriddenMethod;
 170     use Moose;
 171     extends 'Generic';
 172     around configfile => sub { my $orig = shift; shift->__my_configfile };
 173 }
 174
 175 is(
 176     exception {
 177         my $obj = OverriddenMethod->new_with_config;
 178         is($obj->configfile, blessed($obj) . ' file', 'configfile set via overridden sub');
 179         # this is not fixable - the reader method has been shadowed
 180         # is($configfile_sub{blessed($obj)}, 1, 'configfile was calculated just once');
 181         is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from');
 182     },
 183     undef,
 184     'no exceptions',
 185 );
 186
 187 {
 188     package OverriddenMethodAsRole;
 189     use Moose::Role;
 190     with 'GenericRole';
 191     around configfile => sub { my $orig = shift; shift->__my_configfile };
 192 }
 193
 194 is(
 195     exception {
 196         my $obj = Moose::Meta::Class->create_anon_class(
 197             superclasses => ['Base'],
 198             roles => ['OverriddenMethodAsRole'],
 199         )->name->new_with_config;
 200         is($obj->configfile, blessed($obj) . ' file', 'configfile set via overridden sub');
 201         # this is not fixable - the reader method has been shadowed
 202         # is($configfile_sub{blessed($obj)}, 1, 'configfile was calculated just once');
 203         is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from');
 204     },
 205     undef,
 206     'no exceptions',
 207 );
 208
 209
 210 # overridable method for configfile default, and configfile init_arg is changed
 211 {
 212     package OverriddenMethodAndChangedName;
 213     use Moose;
 214     extends 'Generic';
 215     has '+configfile' => (
 216         init_arg => 'my_configfile',
 217     );
 218     around configfile => sub { my $orig = shift; shift->__my_configfile };
 219 }
 220
 221 is(
 222     exception {
 223         my $obj = OverriddenMethodAndChangedName->new_with_config;
 224         is($obj->configfile, blessed($obj) . ' file', 'configfile set via overridden sub');
 225         cmp_deeply(
 226             $constructor_args{blessed($obj)},
 227             {  my_configfile => blessed($obj) . ' file' },
 228             'correct constructor args passed',
 229         );
 230         # this is not fixable - the reader method has been shadowed
 231         # is($configfile_sub{blessed($obj)}, 1, 'configfile was calculated just once');
 232         is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from');
 233     },
 234     undef,
 235     'no exceptions',
 236 );
 237
 238 {
 239     package OverriddenMethodAndChangedNameAsRole;
 240     use Moose::Role;
 241     with 'GenericRole';
 242     use MooseX::Types::Path::Tiny 'Path';
 243     use MooseX::Types::Moose 'Undef';
 244     use Try::Tiny;
 245     has configfile => (
 246         is => 'ro',
 247         isa => Path|Undef,
 248         coerce => 1,
 249         predicate => 'has_configfile',
 250         do { try { require MooseX::Getopt; (traits => ['Getopt']) } },
 251         lazy => 1,
 252         # it sucks that we have to do this rather than using a builder, but some old code
 253         # simply swaps in a new default sub into the attr definition
 254         default => sub { shift->_get_default_configfile },
 255
 256         # this is the overridden bit
 257         init_arg => 'my_configfile',
 258     );
 259     around configfile => sub { my $orig = shift; shift->__my_configfile };
 260 }
 261
 262 is(
 263     exception {
 264         my $obj = Moose::Meta::Class->create_anon_class(
 265             superclasses => ['Base'],
 266             roles => ['OverriddenMethodAndChangedNameAsRole'],
 267         )->name->new_with_config;
 268         is($obj->configfile, blessed($obj) . ' file', 'configfile set via overridden sub');
 269         cmp_deeply(
 270             $constructor_args{blessed($obj)},
 271             { my_configfile => blessed($obj) . ' file' },
 272             'correct constructor args passed',
 273         );
 274         # this is not fixable - the reader method has been shadowed
 275         # is($configfile_sub{blessed($obj)}, 1, 'configfile was calculated just once');
 276         is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from');
 277     },
 278     undef,
 279     'no exceptions',
 280 );
 281
 282
 283 # newly-supported overridable method for configfile default
 284 {
 285     package NewSub;
 286     use Moose;
 287     extends 'Generic';
 288     sub _get_default_configfile { shift->__my_configfile }
 289 }
 290
 291 is(
 292     exception {
 293         my $obj = NewSub->new_with_config;
 294         is($obj->configfile, blessed($obj) . ' file', 'configfile set via new sub');
 295         cmp_deeply(
 296             $constructor_args{blessed($obj)},
 297             {  configfile => blessed($obj) . ' file' },
 298             'correct constructor args passed',
 299         );
 300         is($configfile_sub{blessed($obj)}, 1, 'configfile was calculated just once');
 301         is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from');
 302     },
 303     undef,
 304     'no exceptions',
 305 );
 306
 307 {
 308     package NewSubAsRole;
 309     use Moose::Role;
 310     with 'GenericRole';
 311     sub _get_default_configfile { shift->__my_configfile }
 312 }
 313
 314 is(
 315     exception {
 316         my $obj = Moose::Meta::Class->create_anon_class(
 317             superclasses => ['Base'],
 318             roles => ['NewSubAsRole'],
 319         )->name->new_with_config;
 320         is($obj->configfile, blessed($obj) . ' file', 'configfile set via new sub');
 321         cmp_deeply(
 322             $constructor_args{blessed($obj)},
 323             {  configfile => blessed($obj) . ' file' },
 324             'correct constructor args passed',
 325         );
 326         is($configfile_sub{blessed($obj)}, 1, 'configfile was calculated just once');
 327         is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from');
 328     },
 329     undef,
 330     'no exceptions',
 331 );
 332
 333
 334 # newly-supported overridable method for configfile default, and configfile
 335 # init_arg has been changed
 336 {
 337     package NewSubAndChangedName;
 338     use Moose;
 339     extends 'Generic';
 340     has '+configfile' => (
 341         init_arg => 'my_configfile',
 342     );
 343     sub _get_default_configfile { shift->__my_configfile }
 344 }
 345
 346 is(
 347     exception {
 348         my $obj = NewSubAndChangedName->new_with_config;
 349         is($obj->configfile, blessed($obj) . ' file', 'configfile set via overridden sub');
 350         cmp_deeply(
 351             $constructor_args{blessed($obj)},
 352             {  my_configfile => blessed($obj) . ' file' },
 353             'correct constructor args passed',
 354         );
 355         is($configfile_sub{blessed($obj)}, 1, 'configfile was calculated just once');
 356         is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from');
 357     },
 358     undef,
 359     'no exceptions',
 360 );
 361