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