fix for RT#73325 - call the configfile default sub if it is a sub

[gitmo/MooseX-ConfigFromFile.git] / t / 03configfile_method.t

diff --git a/t/03configfile_method.t b/t/03configfile_method.t
index 4c3f4f8..362ba2f 100644 (file)
--- a/t/03configfile_method.t
+++ b/t/03configfile_method.t
@@ -2,14 +2,21 @@
 use strict;
 use Test::More;
 use Test::Fatal;
+
+
+my %config_from_file_args;
 {
     package A;
     use Moose;
     with qw(MooseX::ConfigFromFile);
 
-    sub configfile { 'moo' }
+    sub configfile { die 'should not ever be here' }
 
-    sub get_config_from_file { {} }
+    sub get_config_from_file {
+        my ($class, $file) = @_;
+        $config_from_file_args{$class} = $file;
+        return {};
+    }
 }
 
 {
@@ -19,10 +26,32 @@ use Test::Fatal;
 
     sub configfile { die; }
     has configfile => ( is => 'bare', default => 'bar' );
+}
 
+{
+    package C;
+    use Moose;
+    extends qw(A);
+
+    sub configfile { die; }
+    has configfile => (
+        is => 'bare',
+        default => sub {
+            my $class = shift;
+            $class = blessed($class) || $class;
+            '/dir/' . $class;
+        },
+    );
 }
 
 is(exception { A->new_with_config() }, undef, 'A->new_with_config lives');
+is($config_from_file_args{A}, undef, 'there is no configfile for A');
+
 is(exception { B->new_with_config() }, undef, 'B->new_with_config lives');
+is($config_from_file_args{B}, 'bar', 'B configfile attr default sub is called');
+
+is(exception { C->new_with_config() }, undef, 'C->new_with_config lives');
+is($config_from_file_args{C}, '/dir/C', 'C configfile attr default sub is called, with classname');
+
 
 done_testing();