use strictures 1;
-use Test::More qw(no_plan);
+use Test::More;
+use Test::Fatal;
+use Package::Variant ();
+
+my @DECLARED;
BEGIN {
- package My::Role::OnOff;
+ package TestSugar;
+ use Exporter 'import';
+ our @EXPORT_OK = qw( declare );
+ sub declare { push @DECLARED, [@_] }
+ $INC{'TestSugar.pm'} = __FILE__;
+}
+BEGIN {
+ package TestVariable;
use Package::Variant
- importing => { 'Moo::Role' => [] },
- subs => [ qw(has before after around) ];
-
+ importing => { 'TestSugar' => [qw( declare )] },
+ subs => [qw( declare )];
sub make_variant {
- my ($me, $into, %args) = @_;
- my $name = $args{name};
- has $name => (is => 'rw');
- install "${name}_on" => sub { shift->$name(1); };
- install "${name}_off" => sub { shift->$name(0); };
+ my ($class, $target, @args) = @_;
+ ::ok(__PACKAGE__->can('install'), 'install() is available')
+ or ::BAIL_OUT('install() subroutine was not exported!');
+ ::ok(__PACKAGE__->can('declare'), 'declare() import is available')
+ or ::BAIL_OUT('proxy declare() subroutine was not exported!');
+ declare target => $target;
+ declare args => [@args];
+ declare class => $class->_test_class_method;
+ install target => sub { $target };
+ install args => sub { [@args] };
}
- $INC{"My/Role/OnOff.pm"} = __FILE__;
+ sub _test_class_method {
+ return shift;
+ }
+ $INC{'TestVariable.pm'} = __FILE__;
+}
+
+my ($variant, $named_variant) = do {
+ package TestScopeA;
+ use TestVariable;
+ (TestVariable(3..7), TestVariable_named("Name", 3..7));
+};
+
+for ($variant, $named_variant) {
+ ok defined($_), 'new variant is a defined value';
+ ok length($_), 'new variant has length';
+ is $_->target, $_, 'target was new variant';
+ is_deeply $_->args, [3..7], 'correct arguments received';
+
+ is_deeply shift(@DECLARED), [target => $_],
+ 'target passed via proxy';
+ is_deeply shift(@DECLARED), [args => [3..7]],
+ 'arguments passed via proxy';
+ is_deeply shift(@DECLARED), [class => 'TestVariable'],
+ 'class method resolution';
}
+is scalar(@DECLARED), 0, 'proxy sub called right amount of times';
+
+ok $named_variant->isa("Name"), 'created class can be named';
+
+use TestVariable as => 'RenamedVar';
+is exception {
+ my $renamed = RenamedVar(9..12);
+ is_deeply $renamed->args, [9..12], 'imported generator can be renamed';
+}, undef, 'no errors for renamed usage';
+
+my @imported;
BEGIN {
- package LightSwitch;
+ package TestImportableA;
+ sub import { push @imported, shift }
+ $INC{'TestImportableA.pm'} = __FILE__;
+ package TestImportableB;
+ sub import { push @imported, shift }
+ $INC{'TestImportableB.pm'} = __FILE__;
+ package TestArrayImports;
+ use Package::Variant
+ importing => [
+ 'TestImportableA',
+ 'TestImportableB',
+ ];
+ sub make_variant { }
+ $INC{'TestArrayImports.pm'} = __FILE__;
+}
- use My::Role::OnOff;
- use Moo;
+use TestArrayImports;
+TestArrayImports(23);
- with OnOff(name => 'lights');
+is_deeply [@imported], [qw( TestImportableA TestImportableB )],
+ 'multiple imports in the right order';
+
+BEGIN {
+ package TestSingleImport;
+ use Package::Variant importing => 'TestImportableA';
+ sub make_variant { }
+ $INC{'TestSingleImport.pm'} = __FILE__;
}
-my $lights = LightSwitch->new;
+@imported = ();
+
+use TestSingleImport;
+TestSingleImport(23);
+
+is_deeply [@imported], [qw( TestImportableA )],
+ 'scalar import works';
+
+@imported = ();
+
+TestSingleImport::->build_variant;
+
+is_deeply [@imported], [qw( TestImportableA )],
+ 'build_variant works';
+
+@imported = ();
+
+is( TestSingleImport::->build_named_variant("Named"), "Named",
+ "build_named_variant applies name" );
+
+is_deeply [@imported], [qw( TestImportableA )],
+ 'build_variant works';
+
+like exception {
+ Package::Variant->import(
+ importing => \'foo', subs => [qw( foo )],
+ );
+}, qr/importing.+option.+hash.+array/i, 'invalid "importing" option';
+
+like exception {
+ Package::Variant->import(
+ importing => { foo => \'bar' }, subs => [qw( bar )],
+ );
+}, qr/import.+argument.+foo.+not.+array/i, 'invalid import argument list';
+
+like exception {
+ Package::Variant->import(
+ importing => [ foo => ['bar'], ['bam'], subs => [qw( bar )] ],
+ );
+}, qr/value.+3.+importing.+not.+string/i, 'importing array invalid key';
+
+like exception {
+ Package::Variant->import(
+ importing => [ foo => \'bam', subs => [qw( bar )] ],
+ );
+}, qr/value.+2.+foo.+importing.+array/i, 'importing array invalid list';
-is($lights->lights, undef, 'Initial state');
-is($lights->lights_on, 1, 'Turn on');
-is($lights->lights, 1, 'On');
-is($lights->lights_off, 0, 'Turn off');
-is($lights->lights, 0, 'Off');
+done_testing;