support for _get_default_configfile - RT#79746
[gitmo/MooseX-ConfigFromFile.git] / t / 05_default_sub.t
diff --git a/t/05_default_sub.t b/t/05_default_sub.t
new file mode 100644 (file)
index 0000000..b36d06e
--- /dev/null
@@ -0,0 +1,184 @@
+use strict;
+use warnings;
+
+use Test::More tests => 20;
+use Test::Fatal;
+use Test::Deep '!blessed';
+use Test::NoWarnings 1.04 ':early';
+use Scalar::Util 'blessed';
+
+my %loaded_file;
+my %constructor_args;
+my %default_sub;
+
+
+# nothing special going on here
+{
+    package Generic;
+    use Moose;
+    with 'MooseX::SimpleConfig';
+    sub get_config_from_file { }
+}
+
+is(
+    exception {
+        my $obj = Generic->new_with_config;
+        is($obj->configfile, undef, 'no configfile set');
+    },
+    undef,
+    'no exceptions',
+);
+
+
+# this is a classic legacy usecase that we must continue to support
+{
+    package OverriddenDefault;
+    use Moose;
+    with 'MooseX::SimpleConfig';
+    sub get_config_from_file
+    {
+        my ($class, $file) = @_;
+        $loaded_file{$file}++;
+        +{}
+    }
+    has '+configfile' => (
+        default => 'OverriddenDefault file',
+    );
+}
+
+is(
+    exception {
+        my $obj = OverriddenDefault->new_with_config;
+        is($obj->configfile, 'OverriddenDefault file', 'configfile set via overridden default');
+        is($loaded_file{'OverriddenDefault file'}, 1, 'correct file was loaded from');
+    },
+    undef,
+    'no exceptions',
+);
+
+
+# legacy usecase, and configfile init_arg has been changed
+{
+    package OverriddenDefaultAndChangedName;
+    use Moose;
+    with 'MooseX::SimpleConfig';
+    sub get_config_from_file
+    {
+        my ($class, $file) = @_;
+        $loaded_file{$file}++;
+        +{}
+    }
+    has '+configfile' => (
+        init_arg => 'my_configfile',
+        default => 'OverriddenDefaultAndChangedName file',
+    );
+    around BUILDARGS => sub {
+        my ($orig, $class) = (shift, shift);
+        my $args = $class->$orig(@_);
+        $constructor_args{$class} = $args;
+    };
+}
+
+is(
+    exception {
+        my $obj = OverriddenDefaultAndChangedName->new_with_config;
+        is($obj->configfile, blessed($obj) . ' file', 'configfile set via overridden default');
+        cmp_deeply(
+            $constructor_args{blessed($obj)},
+            {  my_configfile => blessed($obj) . ' file' },
+            'correct constructor args passed',
+        );
+        is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from');
+    },
+    undef,
+    'no exceptions',
+);
+
+
+# newly-supported overridable method for configfile default
+{
+    package WrapperSub;
+    use Moose;
+    with 'MooseX::SimpleConfig';
+    sub get_config_from_file
+    {
+        my ($class, $file) = @_;
+        $loaded_file{$file}++;
+        +{}
+    }
+
+    sub _get_default_configfile {
+        my $class = shift;
+        $default_sub{$class}++;
+        $class . ' file'
+    }
+
+    around BUILDARGS => sub {
+        my ($orig, $class) = (shift, shift);
+        my $args = $class->$orig(@_);
+        $constructor_args{$class} = $args;
+    };
+}
+
+is(
+    exception {
+        my $obj = WrapperSub->new_with_config;
+        is($obj->configfile, blessed($obj) . ' file', 'configfile set via overridden sub');
+        cmp_deeply(
+            $constructor_args{blessed($obj)},
+            {  configfile => blessed($obj) . ' file' },
+            'correct constructor args passed',
+        );
+        is($default_sub{blessed($obj)}, 1, 'default sub called just once');
+        is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from');
+    },
+    undef,
+    'no exceptions',
+);
+
+
+# newly-supported overridable method for configfile default, and configfile
+# init_arg has been changed
+{
+    package WrapperSubAndChangedName;
+    use Moose;
+    with 'MooseX::SimpleConfig';
+    has '+configfile' => (
+        init_arg => 'my_configfile',
+    );
+    sub get_config_from_file
+    {
+        my ($class, $file) = @_;
+        $loaded_file{$file}++;
+        +{}
+    }
+
+    sub _get_default_configfile {
+        my $class = shift;
+        $default_sub{$class}++;
+        $class . ' file'
+    }
+
+    around BUILDARGS => sub {
+        my ($orig, $class) = (shift, shift);
+        my $args = $class->$orig(@_);
+        $constructor_args{$class} = $args;
+    };
+}
+
+is(
+    exception {
+        my $obj = WrapperSubAndChangedName->new_with_config;
+        is($obj->configfile, blessed($obj) . ' file', 'configfile set via overridden sub');
+        cmp_deeply(
+            $constructor_args{blessed($obj)},
+            {  my_configfile => blessed($obj) . ' file' },
+            'correct constructor args passed',
+        );
+        is($default_sub{blessed($obj)}, 1, 'default sub called just once');
+        is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from');
+    },
+    undef,
+    'no exceptions',
+);
+