t/01simple.t

   1 use strictures 1;
   2 use Test::More;
   3 use Test::Fatal;
   4 use Package::Variant ();
   5
   6 my @DECLARED;
   7
   8 BEGIN {
   9   package TestSugar;
  10   use Exporter;
  11   our @EXPORT_OK = qw( declare );
  12   sub declare { push @DECLARED, [@_] }
  13   $INC{'TestSugar.pm'} = __FILE__;
  14 }
  15
  16 BEGIN {
  17   package TestVariable;
  18   use Package::Variant
  19     importing => { 'TestSugar' => [qw( declare )] },
  20     subs      => [qw( declare )];
  21   sub make_variant {
  22     my ($class, $target, @args) = @_;
  23     ::ok(__PACKAGE__->can('install'), 'install() is available')
  24       or ::BAIL_OUT('install() subroutine was not exported!');
  25     ::ok(__PACKAGE__->can('declare'), 'declare() import is available')
  26       or ::BAIL_OUT('proxy declare() subroutine was not exported!');
  27     declare target => $target;
  28     declare args   => [@args];
  29     declare class  => $class->_test_class_method;
  30     install target => sub { $target };
  31     install args   => sub { [@args] };
  32   }
  33   sub _test_class_method {
  34     return shift;
  35   }
  36   $INC{'TestVariable.pm'} = __FILE__;
  37 }
  38
  39 use TestVariable;
  40
  41 my $variant = TestVariable(3..7);
  42
  43 ok defined($variant), 'new variant is a defined value';
  44 ok length($variant), 'new variant has length';
  45 is $variant->target, $variant, 'target was new variant';
  46 is_deeply $variant->args, [3..7], 'correct arguments received';
  47
  48 is_deeply shift(@DECLARED), [target => $variant],
  49   'target passed via proxy';
  50 is_deeply shift(@DECLARED), [args => [3..7]],
  51   'arguments passed via proxy';
  52 is_deeply shift(@DECLARED), [class => $variant],
  53   'class method resolution';
  54 is scalar(@DECLARED), 0, 'proxy sub called right amount of times';
  55
  56 done_testing;