t/05_default_sub.t

   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