pass current package to custom type reifier

diff --git a/Parameters.xs b/Parameters.xs
index c999c9b..ea7b797 100644 (file)
--- a/Parameters.xs
+++ b/Parameters.xs
@@ -520,8 +520,9 @@ static SV *reify_type(pTHX_ Sentinel sen, const SV *declarator, const KWSpec *sp
        SAVETMPS;
 
        PUSHMARK(SP);
-       EXTEND(SP, 1);
+       EXTEND(SP, 2);
        PUSHs(name);
+       PUSHs(PL_curstname);
        PUTBACK;
 
        n = call_sv(sv, G_SCALAR);

diff --git a/lib/Function/Parameters.pm b/lib/Function/Parameters.pm
index 701046f..577fd68 100644 (file)
--- a/lib/Function/Parameters.pm
+++ b/lib/Function/Parameters.pm
@@ -653,7 +653,8 @@ L</Experimental feature: Types> below).
 
 Valid values: code references. The function specified here will be called to
 turn type annotations into constraint objects (see
-L</Experimental feature: Types> below).
+L</Experimental feature: Types> below). It will receive two arguments: a string
+containing the type description, and the name of the current package.
 
 The default type reifier is equivalent to:
 

diff --git a/t/types_custom_3.t b/t/types_custom_3.t
new file mode 100644 (file)
index 0000000..769ce0e
--- /dev/null
+++ b/t/types_custom_3.t
@@ -0,0 +1,47 @@
+#!perl
+use warnings FATAL => 'all';
+use strict;
+
+use Test::More tests => 8;
+
+{
+       package TX;
+
+       sub check { 1 }
+
+       our $obj;
+       BEGIN { $obj = bless {}, 'TX'; }
+}
+
+use Function::Parameters {
+       fun => {
+               check_argument_count => 1,
+               reify_type => sub {
+                       my ($type, $package) = @_;
+                       if ($package ne $type) {
+                               my (undef, $file, $line) = @_;
+                               diag "";
+                               diag "! $file : $line";
+                       }
+                       is $package, $type;
+                       $TX::obj
+               },
+       },
+};
+
+fun f1(main $x) {}
+fun Asdf::f1(main $x) {}
+
+{
+       package Foo::Bar::Baz;
+
+       fun f1(Foo::Bar::Baz $x) {}
+       fun Ghjk::f1(Foo::Bar::Baz $x) {}
+
+       package AAA;
+       fun f1(AAA $x) {}
+       fun main::f2(AAA $x) {}
+}
+
+fun f3(main $x) {}
+fun Ghjk::f2(main $x) {}