t/05_default_sub.t

   1 use strict;
   2 use warnings FATAL => 'all';
   3
   4 use Test::More tests => 33;
   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 # this is a classic legacy usecase from old documentation that we must
  56 # continue to support
  57 {
  58     package OverriddenDefault;
  59     use Moose;
  60     extends 'Generic';
  61     has '+configfile' => (
  62         default => 'OverriddenDefault file',
  63     );
  64 }
  65
  66 is(
  67     exception {
  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');
  71     },
  72     undef,
  73     'no exceptions',
  74 );
  75
  76 {
  77     package OverriddenDefaultMethod;
  78     use Moose;
  79     extends 'Generic';
  80     has '+configfile' => (
  81         default => sub { shift->__my_configfile },
  82     );
  83 }
  84
  85 is(
  86     exception {
  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');
  91     },
  92     undef,
  93     'no exceptions',
  94 );
  95
  96
  97 # legacy usecase, and configfile init_arg has been changed
  98 {
  99     package OverriddenDefaultAndChangedName;
 100     use Moose;
 101     extends 'Generic';
 102     has '+configfile' => (
 103         init_arg => 'my_configfile',
 104         default => 'OverriddenDefaultAndChangedName file',
 105     );
 106 }
 107
 108 is(
 109     exception {
 110         my $obj = OverriddenDefaultAndChangedName->new_with_config;
 111         is($obj->configfile, blessed($obj) . ' file', 'configfile set via overridden default');
 112         cmp_deeply(
 113             $constructor_args{blessed($obj)},
 114             {  my_configfile => blessed($obj) . ' file' },
 115             'correct constructor args passed',
 116         );
 117         is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from');
 118     },
 119     undef,
 120     'no exceptions',
 121 );
 122
 123 # "reader" method is overridden to provide for configfile default
 124 {
 125     package OverriddenMethod;
 126     use Moose;
 127     extends 'Generic';
 128     around configfile => sub { my $orig = shift; shift->__my_configfile };
 129 }
 130
 131 is(
 132     exception {
 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');
 138     },
 139     undef,
 140     'no exceptions',
 141 );
 142
 143
 144 # overridable method for configfile default, and configfile init_arg is changed
 145 {
 146     package OverriddenMethodAndChangedName;
 147     use Moose;
 148     extends 'Generic';
 149     has '+configfile' => (
 150         init_arg => 'my_configfile',
 151     );
 152     around configfile => sub { my $orig = shift; shift->__my_configfile };
 153 }
 154
 155 is(
 156     exception {
 157         my $obj = OverriddenMethodAndChangedName->new_with_config;
 158         is($obj->configfile, blessed($obj) . ' file', 'configfile set via overridden sub');
 159         cmp_deeply(
 160             $constructor_args{blessed($obj)},
 161             {  my_configfile => blessed($obj) . ' file' },
 162             'correct constructor args passed',
 163         );
 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');
 167     },
 168     undef,
 169     'no exceptions',
 170 );
 171
 172 # newly-supported overridable method for configfile default
 173 {
 174     package NewSub;
 175     use Moose;
 176     extends 'Generic';
 177     sub _get_default_configfile { shift->__my_configfile }
 178 }
 179
 180 is(
 181     exception {
 182         my $obj = NewSub->new_with_config;
 183         is($obj->configfile, blessed($obj) . ' file', 'configfile set via new sub');
 184         cmp_deeply(
 185             $constructor_args{blessed($obj)},
 186             {  configfile => blessed($obj) . ' file' },
 187             'correct constructor args passed',
 188         );
 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');
 191     },
 192     undef,
 193     'no exceptions',
 194 );
 195
 196 # newly-supported overridable method for configfile default, and configfile
 197 # init_arg has been changed
 198 {
 199     package NewSubAndChangedName;
 200     use Moose;
 201     extends 'Generic';
 202     has '+configfile' => (
 203         init_arg => 'my_configfile',
 204     );
 205     sub _get_default_configfile { shift->__my_configfile }
 206 }
 207
 208 is(
 209     exception {
 210         my $obj = NewSubAndChangedName->new_with_config;
 211         is($obj->configfile, blessed($obj) . ' file', 'configfile set via overridden sub');
 212         cmp_deeply(
 213             $constructor_args{blessed($obj)},
 214             {  my_configfile => blessed($obj) . ' file' },
 215             'correct constructor args passed',
 216         );
 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');
 219     },
 220     undef,
 221     'no exceptions',
 222 );
 223