X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Ftypes_custom_2.t;fp=t%2Ftypes_custom_2.t;h=f22ae0e035f51574248c69e7f59401e1c8cd8586;hb=7193dffba45795c249b405f8636d644261380ff0;hp=0000000000000000000000000000000000000000;hpb=d72d56ce74efe8558da8154d85aea834ff87dfc6;p=p5sagit%2FFunction-Parameters.git

diff --git a/t/types_custom_2.t b/t/types_custom_2.t
new file mode 100644
index 0000000..f22ae0e
--- /dev/null
+++ b/t/types_custom_2.t
@@ -0,0 +1,61 @@
+#!perl
+use warnings FATAL => 'all';
+use strict;
+
+use Test::More tests => 4;
+use Test::Fatal;
+
+{
+	package MyTC;
+
+	use Function::Parameters qw(:strict);
+
+	method new(
+		$class:
+		$name,
+		$check,
+		$get_message = fun ($value) {
+			"Validation failed for constraint '$name' with value '$value'"
+		},
+	) {
+		bless {
+			name => $name,
+			check => $check,
+			get_message => $get_message,
+		}, $class
+	}
+
+	method check($value) {
+		$self->{check}($value)
+	}
+
+	method get_message($value) {
+		$self->{get_message}($value)
+	}
+}
+
+use Function::Parameters do {
+	use Function::Parameters qw(:strict);
+
+	my %Types = (
+		TEvenNum  => MyTC->new('even number'  => fun ($n) { $n =~ /^[0-9]+\z/ && $n % 2 == 0 }),
+		TShortStr => MyTC->new('short string' => fun ($s) { length($s) < 10 }),
+		Any       => MyTC->new('any value'    => fun ($a) { 1 }),
+	);
+	+{
+		fun => {
+			check_argument_count => 1,
+			types => 1,
+			reify_type => sub { $Types{ $_[0] } || $Types{Any} },
+		},
+	}
+};
+
+fun foo(TEvenNum $x, TShortStr $y) {
+	"$x/$y"
+}
+
+is foo(42, "hello"), "42/hello";
+like exception { foo 41, "hello" },       qr{\bValidation failed for constraint 'even number' with value '41'};
+like exception { foo 42, "1234567890~" }, qr{\bValidation failed for constraint 'short string' with value '1234567890~'};
+like exception { foo 41, "1234567890~" }, qr{\bValidation failed for constraint 'even number' with value '41'};