t/040_type_constraints/010_misc_type_tests.t

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