X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit%2FPackage-Variant.git;a=blobdiff_plain;f=t%2F01simple.t;h=6e8348c4957ef9a408d6169e5ecf40850af77a88;hp=535d499f309b5b56e0800ac4eef233efd34998e6;hb=6779ecfd9c1a2a51cc5c26596ced7a36e27cf9dd;hpb=f9c096bb0bb7309f1be31d001f7eba966bb273de diff --git a/t/01simple.t b/t/01simple.t index 535d499..6e8348c 100644 --- a/t/01simple.t +++ b/t/01simple.t @@ -7,7 +7,7 @@ my @DECLARED; BEGIN { package TestSugar; - use Exporter; + use Exporter 'import'; our @EXPORT_OK = qw( declare ); sub declare { push @DECLARED, [@_] } $INC{'TestSugar.pm'} = __FILE__; @@ -36,9 +36,11 @@ BEGIN { $INC{'TestVariable.pm'} = __FILE__; } -use TestVariable; - -my $variant = TestVariable(3..7); +my $variant = do { + package TestScopeA; + use TestVariable; + TestVariable(3..7); +}; ok defined($variant), 'new variant is a defined value'; ok length($variant), 'new variant has length'; @@ -49,8 +51,103 @@ is_deeply shift(@DECLARED), [target => $variant], 'target passed via proxy'; is_deeply shift(@DECLARED), [args => [3..7]], 'arguments passed via proxy'; -is_deeply shift(@DECLARED), [class => $variant], +is_deeply shift(@DECLARED), [class => 'TestVariable'], 'class method resolution'; is scalar(@DECLARED), 0, 'proxy sub called right amount of times'; +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 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 TestArrayImports; +TestArrayImports(23); + +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__; +} + +@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'; + +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'; + +BEGIN { + package TestOverrideName; + + use Package::Variant; + + sub make_variant_package_name { + my (undef, @args) = @_; + return $args[0]; + } + + sub make_variant { + install hey => sub { 'hey' }; + } +} + +is(TestOverrideName::->build_variant('hey'), 'hey'); + +is(hey->hey, 'hey', 'hey'); + done_testing;