t/11_library-definition.t

   1 #!/usr/bin/env perl
   2 use warnings;
   3 use strict;
   4
   5 use Test::More;
   6 use FindBin;
   7 use lib "$FindBin::Bin/lib";
   8 use TestLibrary qw( NonEmptyStr IntArrayRef ),
   9                 Foo2Alias => { -as => 'Foo' };
  10
  11 my @tests = (
  12     [ 'NonEmptyStr', 12, "12", [], "foobar", "" ],
  13     [ 'IntArrayRef', 12, [12], {}, [17, 23], {} ],
  14 );
  15
  16 # new array ref so we can safely shift from it
  17 for my $data (map { [@$_] } @tests) {
  18     my $type = shift @$data;
  19
  20     # Type name export
  21     {
  22         ok my $code = __PACKAGE__->can($type), "$type() was exported";
  23         is $code->(), "TestLibrary::$type", "$type() returned correct type name";
  24     }
  25
  26     # coercion handler export
  27     {
  28         my ($coerce, $coercion_result, $cannot_coerce) = map { shift @$data } 1 .. 3;
  29         ok my $code = __PACKAGE__->can("to_$type"), "to_$type() coercion was exported";
  30         is_deeply scalar $code->($coerce), $coercion_result, "to_$type() coercion works";
  31         ok ! $code->($cannot_coerce), "to_$type() returns false on invalid value";
  32     }
  33
  34     # type test handler
  35     {
  36         my ($valid, $invalid) = map { shift @$data } 1 .. 2;
  37         ok my $code = __PACKAGE__->can("is_$type"), "is_$type() check was exported";
  38         ok $code->($valid), "is_$type() check true on valid value";
  39         ok ! $code->($invalid), "is_$type() check false on invalid value";
  40     }
  41 }
  42
  43 # aliasing test
  44 ok my $code = __PACKAGE__->can('Foo'),      'aliased type exported under correct symbol';
  45 is $code->(), 'TestLibrary::Foo2Alias',     'aliased type returns unaliased type name';
  46
  47 # coercion not available
  48 ok ! __PACKAGE__->can('to_TwentyThree'), "type without coercion doesn't have to_* helper";
  49
  50 eval { require TestNamespaceSep };
  51 ok   $@,                q(trying to declare a type with '::' in it croaks);
  52 like $@, qr/Foo::Bar/,  q(error message contains type name);
  53
  54 done_testing;