t/types_custom_2.t

   1 #!perl
   2 use warnings FATAL => 'all';
   3 use strict;
   4
   5 use Test::More tests => 4;
   6 use Test::Fatal;
   7
   8 {
   9         package MyTC;
  10
  11         use Function::Parameters qw(:strict);
  12
  13         method new(
  14                 $class:
  15                 $name,
  16                 $check,
  17                 $get_message = fun ($value) {
  18                         "Validation failed for constraint '$name' with value '$value'"
  19                 },
  20         ) {
  21                 bless {
  22                         name => $name,
  23                         check => $check,
  24                         get_message => $get_message,
  25                 }, $class
  26         }
  27
  28         method check($value) {
  29                 $self->{check}($value)
  30         }
  31
  32         method get_message($value) {
  33                 $self->{get_message}($value)
  34         }
  35 }
  36
  37 use Function::Parameters do {
  38         use Function::Parameters qw(:strict);
  39
  40         my %Types = (
  41                 TEvenNum  => MyTC->new('even number'  => fun ($n) { $n =~ /^[0-9]+\z/ && $n % 2 == 0 }),
  42                 TShortStr => MyTC->new('short string' => fun ($s) { length($s) < 10 }),
  43                 Any       => MyTC->new('any value'    => fun ($a) { 1 }),
  44         );
  45         +{
  46                 fun => {
  47                         check_argument_count => 1,
  48                         reify_type => sub { $Types{ $_[0] } || $Types{Any} },
  49                 },
  50         }
  51 };
  52
  53 fun foo(TEvenNum $x, TShortStr $y) {
  54         "$x/$y"
  55 }
  56
  57 is foo(42, "hello"), "42/hello";
  58 like exception { foo 41, "hello" },       qr{\bValidation failed for constraint 'even number' with value '41'};
  59 like exception { foo 42, "1234567890~" }, qr{\bValidation failed for constraint 'short string' with value '1234567890~'};
  60 like exception { foo 41, "1234567890~" }, qr{\bValidation failed for constraint 'even number' with value '41'};