Commit | Line | Data |
f9c096bb |
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; |
1abbe9d7 |
10 | use Exporter 'import'; |
f9c096bb |
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 | |
b6086e0d |
39 | my $variant = do { |
40 | package TestScopeA; |
41 | use TestVariable; |
42 | TestVariable(3..7); |
43 | }; |
f9c096bb |
44 | |
45 | ok defined($variant), 'new variant is a defined value'; |
46 | ok length($variant), 'new variant has length'; |
47 | is $variant->target, $variant, 'target was new variant'; |
48 | is_deeply $variant->args, [3..7], 'correct arguments received'; |
49 | |
50 | is_deeply shift(@DECLARED), [target => $variant], |
51 | 'target passed via proxy'; |
52 | is_deeply shift(@DECLARED), [args => [3..7]], |
53 | 'arguments passed via proxy'; |
1abbe9d7 |
54 | is_deeply shift(@DECLARED), [class => 'TestVariable'], |
f9c096bb |
55 | 'class method resolution'; |
56 | is scalar(@DECLARED), 0, 'proxy sub called right amount of times'; |
57 | |
b6086e0d |
58 | use TestVariable as => 'RenamedVar'; |
59 | is exception { |
60 | my $renamed = RenamedVar(9..12); |
61 | is_deeply $renamed->args, [9..12], 'imported generator can be renamed'; |
62 | }, undef, 'no errors for renamed usage'; |
63 | |
f9c096bb |
64 | done_testing; |