From: Lukas Mai <l.mai@web.de>
Date: Mon, 12 Aug 2013 20:44:19 +0000 (+0200)
Subject: pass current package to custom type reifier
X-Git-Tag: v1.0201~3^2
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit%2FFunction-Parameters.git;a=commitdiff_plain;h=e7c6de2cbea5feab6bb571d597714ef7e1fac080

pass current package to custom type reifier
---

diff --git a/Parameters.xs b/Parameters.xs
index c999c9b..ea7b797 100644
--- 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
--- 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
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) {}