Merge ec6d852 into 50c028b

lib/Function/Interface/Impl.pm

@@ -5,7 +5,7 @@ use warnings;
 
 our $VERSION = "0.03";
 
-use Class::Load qw(load_class try_load_class);
+use Class::Load qw(load_class try_load_class is_class_loaded);
 use Scalar::Util qw(blessed);
 
 sub import {
@@ -44,28 +44,35 @@ sub assert_valid {
     my ($package, $interface_package, $filename, $line) = @_;
     my @fl = ($filename, $line);
 
-    my ($ok, $e) = try_load_class($interface_package);
-    error($e, @fl) if !$ok;
+    {
+        my $ok = is_class_loaded($package);
+        return error("implements package is not loaded yet. required to use $package", @fl) if !$ok;
+    }
+
+    {
+        my ($ok, $e) = try_load_class($interface_package);
+        return error("cannot load interface package: $e", @fl) if !$ok;
+    }
 
     my $iinfo = info_interface($interface_package)
-            or error("cannot get interface info", @fl);
+            or return error("cannot get interface info", @fl);
 
     for my $ifunction_info (@{$iinfo->functions}) {
         my $fname = $ifunction_info->subname;
         my $def   = $ifunction_info->definition;
 
         my $code = $package->can($fname)
-            or error("function `$fname` is required. Interface: $def", @fl);
+            or return error("function `$fname` is required. Interface: $def", @fl);
 
         my $pinfo = info_params($code)
-            or error("cannot get function `$fname` parameters info. Interface: $def", @fl);
+            or return error("cannot get function `$fname` parameters info. Interface: $def", @fl);
         my $rinfo = info_return($code)
-            or error("cannot get function `$fname` return info. Interface: $def", @fl);
+            or return error("cannot get function `$fname` return info. Interface: $def", @fl);
 
         check_params($pinfo, $ifunction_info)
-            or error("function `$fname` is invalid parameters. Interface: $def", @fl);
+            or return error("function `$fname` is invalid parameters. Interface: $def", @fl);
         check_return($rinfo, $ifunction_info)
-            or error("function `$fname` is invalid return. Interface: $def", @fl);
+            or return error("function `$fname` is invalid return. Interface: $def", @fl);
     }
 }
 

t/01_function_interface/info.t

@@ -7,40 +7,47 @@ fun foo() :Return();
 fun bar(Str $msg) :Return(Int);
 method baz() :Return();
 
-my $info = Function::Interface::info __PACKAGE__;
-
-is $info->package, 'main';
-is @{$info->functions}, 3;
-
-subtest 'foo' => sub {
-    my $i = $info->functions->[0];
-    is $i->subname, 'foo';
-    is $i->keyword, 'fun';
-    is $i->params, [];
-    is $i->return, [];
-};
-
-subtest 'bar' => sub {
-    my $i = $info->functions->[1];
-    is $i->subname, 'bar';
-    is $i->keyword, 'fun';
-
-    is @{$i->params}, 1;
-    isa_ok $i->params->[0], 'Function::Interface::Info::Function::Param';
-    ok $i->params->[0]->type eq Str;
-    is $i->params->[0]->name, '$msg';
-
-    is @{$i->return}, 1;
-    isa_ok $i->return->[0], 'Function::Interface::Info::Function::ReturnParam';
-    ok $i->return->[0]->type eq Int;
+subtest 'basic' => sub {
+    my $info = Function::Interface::info __PACKAGE__;
+
+    is $info->package, 'main';
+    is @{$info->functions}, 3;
+
+    subtest 'foo' => sub {
+        my $i = $info->functions->[0];
+        is $i->subname, 'foo';
+        is $i->keyword, 'fun';
+        is $i->params, [];
+        is $i->return, [];
+    };
+
+    subtest 'bar' => sub {
+        my $i = $info->functions->[1];
+        is $i->subname, 'bar';
+        is $i->keyword, 'fun';
+
+        is @{$i->params}, 1;
+        isa_ok $i->params->[0], 'Function::Interface::Info::Function::Param';
+        ok $i->params->[0]->type eq Str;
+        is $i->params->[0]->name, '$msg';
+
+        is @{$i->return}, 1;
+        isa_ok $i->return->[0], 'Function::Interface::Info::Function::ReturnParam';
+        ok $i->return->[0]->type eq Int;
+    };
+
+    subtest 'baz' => sub {
+        my $i = $info->functions->[2];
+        is $i->subname, 'baz';
+        is $i->keyword, 'method';
+        is $i->params, [];
+        is $i->return, [];
+    };
 };
 
-subtest 'baz' => sub {
-    my $i = $info->functions->[2];
-    is $i->subname, 'baz';
-    is $i->keyword, 'method';
-    is $i->params, [];
-    is $i->return, [];
+subtest 'empty' => sub {
+    my $info = Function::Interface::info 'Hoge';
+    is $info, undef;
 };
 
 done_testing;

t/03_function_interface_impl/assert_valid.t

@@ -0,0 +1,51 @@
+use Test2::V0;
+use lib 't/lib';
+
+use Function::Interface::Impl;
+
+BEGIN {
+    no warnings qw(redefine);
+    *Function::Interface::Impl::error = sub {
+        return "DIED: @_";
+    }
+}
+
+use Foo;
+use FooNoFoo;
+use FooNoParamsInfo;
+use FooNoReturnInfo;
+use FooInvalidParams;
+use FooInvalidReturn;
+
+sub assert_valid {
+    my ($package, $interface_package) = @_;
+    Function::Interface::Impl::assert_valid(
+        $package, $interface_package, __FILE__, __LINE__
+    );
+}
+
+like assert_valid('Fo', 'IFoo'),
+    qr/^DIED: implements package is not loaded yet. required to use/, 'cannot load impl package';
+
+like assert_valid('Foo', 'IFo'),
+    qr/^DIED: cannot load interface package: Can't locate IFo.pm/, 'cannot load interface package';
+
+like assert_valid('Foo', 'Test2'),
+    qr/^DIED: cannot get interface info/, 'cannot get interface info';
+
+like assert_valid('FooNoFoo', 'IFoo'),
+    qr/^DIED: function `foo` is required/, 'required methods';
+
+like assert_valid('FooNoParamsInfo', 'IFoo'),
+    qr/^DIED: cannot get function `foo` parameters info/, 'required params info';
+
+like assert_valid('FooNoReturnInfo', 'IFoo'),
+    qr/^DIED: cannot get function `foo` return info/, 'required return info';
+
+like assert_valid('FooInvalidParams', 'IFoo'),
+    qr/^DIED: function `foo` is invalid parameters/, 'invalid params';
+
+like assert_valid('FooInvalidReturn', 'IFoo'),
+    qr/^DIED: function `foo` is invalid return/, 'invalid return';
+
+done_testing;

t/lib/FooInvalidParams.pm

@@ -0,0 +1,10 @@
+package FooInvalidParams;
+use Function::Interface::Impl qw(IFoo);
+use Function::Return;
+use Function::Parameters;
+
+use Types::Standard -types;
+
+fun foo(Str $a) :Return() {}
+
+1;

t/lib/FooInvalidReturn.pm

@@ -0,0 +1,10 @@
+package FooInvalidReturn;
+use Function::Interface::Impl qw(IFoo);
+use Function::Return;
+use Function::Parameters;
+
+use Types::Standard -types;
+
+fun foo() :Return(Str) {}
+
+1;

t/lib/FooNoFoo.pm

@@ -0,0 +1,5 @@
+package FooNoFoo;
+
+sub test {}
+
+1;

t/lib/FooNoParamsInfo.pm

@@ -0,0 +1,7 @@
+package FooNoParamsInfo;
+use Function::Interface::Impl qw(IFoo);
+use Function::Return;
+
+sub foo :Return() {}
+
+1;

t/lib/FooNoReturnInfo.pm

@@ -0,0 +1,7 @@
+package FooNoReturnInfo;
+use Function::Interface::Impl qw(IFoo);
+use Function::Parameters;
+
+fun foo() {}
+
+1;