t/03configfile_method.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use Test::More;
   4 use Test::Fatal;
   5
   6
   7 my %config_from_file_args;
   8 {
   9     package A;
  10     use Moose;
  11     with qw(MooseX::ConfigFromFile);
  12
  13     sub configfile { die 'should not ever be here' }
  14
  15     sub get_config_from_file {
  16         my ($class, $file) = @_;
  17         $config_from_file_args{$class} = $file;
  18         return {};
  19     }
  20 }
  21
  22 {
  23     package B;
  24     use Moose;
  25     extends qw(A);
  26
  27     sub configfile { die; }
  28     has configfile => ( is => 'bare', default => 'bar' );
  29 }
  30
  31 {
  32     package C;
  33     use Moose;
  34     extends qw(A);
  35
  36     sub configfile { die; }
  37     has configfile => (
  38         is => 'bare',
  39         default => sub {
  40             my $class = shift;
  41             $class = blessed($class) || $class;
  42             '/dir/' . $class;
  43         },
  44     );
  45 }
  46
  47 is(exception { A->new_with_config() }, undef, 'A->new_with_config lives');
  48 is($config_from_file_args{A}, undef, 'there is no configfile for A');
  49
  50 is(exception { B->new_with_config() }, undef, 'B->new_with_config lives');
  51 is($config_from_file_args{B}, 'bar', 'B configfile attr default sub is called');
  52
  53 is(exception { C->new_with_config() }, undef, 'C->new_with_config lives');
  54 is($config_from_file_args{C}, '/dir/C', 'C configfile attr default sub is called, with classname');
  55
  56
  57 done_testing();