t/03configfile_method.t

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