t/040_type_constraints/010_misc_type_tests.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7 use Test::Exception;
   8 use Scalar::Util qw(refaddr);
   9
  10 BEGIN {
  11     use_ok('Mouse::Util::TypeConstraints');
  12 }
  13
  14 # subtype 'aliasing' ...
  15
  16 lives_ok {
  17     subtype 'Numb3rs' => as 'Num';
  18 } '... create bare subtype fine';
  19
  20 my $numb3rs = find_type_constraint('Numb3rs');
  21 isa_ok($numb3rs, 'Mouse::Meta::TypeConstraint');
  22
  23 # subtype with unions
  24
  25 {
  26     package Test::Mouse::Meta::TypeConstraint::Union;
  27
  28     use overload '""' => sub {'Broken|Test'}, fallback => 1;
  29     use Mouse;
  30
  31     extends 'Mouse::Meta::TypeConstraint';
  32 }
  33
  34 my $dummy_instance = Test::Mouse::Meta::TypeConstraint::Union->new;
  35
  36 ok $dummy_instance => "Created Instance";
  37
  38 isa_ok $dummy_instance,
  39     'Test::Mouse::Meta::TypeConstraint::Union' => 'isa correct type';
  40
  41 is "$dummy_instance", "Broken|Test" =>
  42     'Got expected stringification result';
  43
  44 my $subtype1 = subtype 'New1' => as $dummy_instance;
  45
  46 ok $subtype1 => 'made a subtype from our type object';
  47
  48 my $subtype2 = subtype 'New2' => as $subtype1;
  49
  50 ok $subtype2 => 'made a subtype of our subtype';
  51
  52 # assert_valid
  53
  54 {
  55     my $type = find_type_constraint('Num');
  56
  57     my $ok_1 = eval { $type->assert_valid(1); };
  58     ok($ok_1, "we can assert_valid that 1 is of type $type");
  59
  60     my $ok_2 = eval { $type->assert_valid('foo'); };
  61     my $error = $@;
  62     ok(! $ok_2, "'foo' is not of type $type");
  63     like(
  64         $error,
  65         qr{validation failed for .\Q$type\E.}i,
  66         "correct error thrown"
  67     );
  68 }
  69
  70 {
  71     for my $t (qw(Bar Foo)) {
  72         my $tc = Mouse::Meta::TypeConstraint->new({
  73             name => $t,
  74         });
  75
  76         Mouse::Util::TypeConstraints::register_type_constraint($tc);
  77     }
  78
  79     my $foo = Mouse::Util::TypeConstraints::find_type_constraint('Foo');
  80     my $bar = Mouse::Util::TypeConstraints::find_type_constraint('Bar');
  81
  82     ok(!$foo->is_a_type_of($bar), "Foo type is not equal to Bar type");
  83     ok( $foo->is_a_type_of($foo), "Foo equals Foo");
  84     ok( 0+$foo == refaddr($foo), "overloading works");
  85 }
  86
  87 ok $subtype1, "type constraint boolean overload works";
  88
  89 done_testing;