X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F01simple.t;h=2d518734430c11e5ccd99b36197485bffd317b66;hb=815b5be2c946367c4d74c815599ea9d706c0f5e3;hp=2b33250f384a7ec15ec1f375dcd16fd1fb9af4dc;hpb=236a4386470d4edcbdda8a7d5564dd04401c7027;p=p5sagit%2FPackage-Variant.git

diff --git a/t/01simple.t b/t/01simple.t
index 2b33250..2d51873 100644
--- a/t/01simple.t
+++ b/t/01simple.t
@@ -1,36 +1,88 @@
 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] };
+  }
+  sub _test_class_method {
+    return shift;
   }
-  $INC{"My/Role/OnOff.pm"} = __FILE__;
+  $INC{'TestVariable.pm'} = __FILE__;
 }
 
-BEGIN {
-  package LightSwitch;
+my $variant = do {
+    package TestScopeA;
+    use TestVariable;
+    TestVariable(3..7);
+};
 
-  use My::Role::OnOff;
-  use Moo;
+ok defined($variant), 'new variant is a defined value';
+ok length($variant), 'new variant has length';
+is $variant->target, $variant, 'target was new variant';
+is_deeply $variant->args, [3..7], 'correct arguments received';
 
-  with OnOff(name => 'lights');
+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 => '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 => undef,
+      TestImportableB => undef,
+    ];
+  sub make_variant { }
+  $INC{'TestArrayImports.pm'} = __FILE__;
 }
 
-my $lights = LightSwitch->new;
+use TestArrayImports;
+TestArrayImports(23);
+
+is_deeply [@imported], [qw( TestImportableA TestImportableB )],
+  'multiple imports in the right order';
 
-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;