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 'import';
  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 my ($variant, $named_variant) = do {
  40     package TestScopeA;
  41     use TestVariable;
  42     (TestVariable(3..7), TestVariable_named("Name", 3..7));
  43 };
  44
  45 for ($variant, $named_variant) {
  46   ok defined($_), 'new variant is a defined value';
  47   ok length($_), 'new variant has length';
  48   is $_->target, $_, 'target was new variant';
  49   is_deeply $_->args, [3..7], 'correct arguments received';
  50
  51   is_deeply shift(@DECLARED), [target => $_],
  52     'target passed via proxy';
  53   is_deeply shift(@DECLARED), [args => [3..7]],
  54     'arguments passed via proxy';
  55   is_deeply shift(@DECLARED), [class => 'TestVariable'],
  56     'class method resolution';
  57 }
  58
  59 is scalar(@DECLARED), 0, 'proxy sub called right amount of times';
  60
  61 ok $named_variant->isa("Name"), 'created class can be named';
  62
  63 use TestVariable as => 'RenamedVar';
  64 is exception {
  65   my $renamed = RenamedVar(9..12);
  66   is_deeply $renamed->args, [9..12], 'imported generator can be renamed';
  67 }, undef, 'no errors for renamed usage';
  68
  69 my @imported;
  70 BEGIN {
  71   package TestImportableA;
  72   sub import { push @imported, shift }
  73   $INC{'TestImportableA.pm'} = __FILE__;
  74   package TestImportableB;
  75   sub import { push @imported, shift }
  76   $INC{'TestImportableB.pm'} = __FILE__;
  77   package TestArrayImports;
  78   use Package::Variant
  79     importing => [
  80       'TestImportableA',
  81       'TestImportableB',
  82     ];
  83   sub make_variant { }
  84   $INC{'TestArrayImports.pm'} = __FILE__;
  85 }
  86
  87 use TestArrayImports;
  88 TestArrayImports(23);
  89
  90 is_deeply [@imported], [qw( TestImportableA TestImportableB )],
  91   'multiple imports in the right order';
  92
  93 BEGIN {
  94   package TestSingleImport;
  95   use Package::Variant importing => 'TestImportableA';
  96   sub make_variant { }
  97   $INC{'TestSingleImport.pm'} = __FILE__;
  98 }
  99
 100 @imported = ();
 101
 102 use TestSingleImport;
 103 TestSingleImport(23);
 104
 105 is_deeply [@imported], [qw( TestImportableA )],
 106   'scalar import works';
 107
 108 @imported = ();
 109
 110 TestSingleImport::->build_variant;
 111
 112 is_deeply [@imported], [qw( TestImportableA )],
 113   'build_variant works';
 114
 115 @imported = ();
 116
 117 is( TestSingleImport::->build_named_variant("Named"), "Named",
 118   "build_named_variant applies name" );
 119
 120 is_deeply [@imported], [qw( TestImportableA )],
 121   'build_variant works';
 122
 123 like exception {
 124   Package::Variant->import(
 125     importing => \'foo', subs => [qw( foo )],
 126   );
 127 }, qr/importing.+option.+hash.+array/i, 'invalid "importing" option';
 128
 129 like exception {
 130   Package::Variant->import(
 131     importing => { foo => \'bar' }, subs => [qw( bar )],
 132   );
 133 }, qr/import.+argument.+foo.+not.+array/i, 'invalid import argument list';
 134
 135 like exception {
 136   Package::Variant->import(
 137     importing => [ foo => ['bar'], ['bam'], subs => [qw( bar )] ],
 138   );
 139 }, qr/value.+3.+importing.+not.+string/i, 'importing array invalid key';
 140
 141 like exception {
 142   Package::Variant->import(
 143     importing => [ foo => \'bam', subs => [qw( bar )] ],
 144   );
 145 }, qr/value.+2.+foo.+importing.+array/i, 'importing array invalid list';
 146
 147 done_testing;