t/010_basics/011_moose_respects_type_constraints.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 use Test::Exception;
  11
  12 use Mouse::Util::TypeConstraints;
  13
  14 =pod
  15
  16 This tests demonstrates that Mouse will not override
  17 a preexisting type constraint of the same name when
  18 making constraints for a Mouse-class.
  19
  20 It also tests that an attribute which uses a 'Foo' for
  21 it's isa option will get the subtype Foo, and not a
  22 type representing the Foo moose class.
  23
  24 =cut
  25
  26 BEGIN {
  27     # create this subtype first (in BEGIN)
  28     subtype Foo
  29         => as 'Value'
  30         => where { $_ eq 'Foo' };
  31 }
  32
  33 { # now seee if Mouse will override it
  34     package Foo;
  35     use Mouse;
  36 }
  37
  38 my $foo_constraint = find_type_constraint('Foo');
  39 isa_ok($foo_constraint, 'Mouse::Meta::TypeConstraint');
  40
  41 is($foo_constraint->parent->name, 'Value', '... got the Value subtype for Foo');
  42
  43 ok($foo_constraint->check('Foo'), '... my constraint passed correctly');
  44 ok(!$foo_constraint->check('Bar'), '... my constraint failed correctly');
  45
  46 {
  47     package Bar;
  48     use Mouse;
  49
  50     has 'foo' => (is => 'rw', isa => 'Foo');
  51 }
  52
  53 my $bar = Bar->new;
  54 isa_ok($bar, 'Bar');
  55
  56 lives_ok {
  57     $bar->foo('Foo');
  58 } '... checked the type constraint correctly';
  59
  60 dies_ok {
  61     $bar->foo(Foo->new);
  62 } '... checked the type constraint correctly';
  63
  64 done_testing;