t/040_type_constraints/030-class_subtypes.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 18;
   7 use Test::Exception;
   8
   9 use Moose::Util::TypeConstraints;
  10 use Moose::Meta::TypeConstraint;
  11
  12
  13 ## Create a subclass with a custom method
  14
  15 {
  16     package Test::Moose::Meta::TypeConstraint::AnySubType;
  17     use Moose;
  18     extends 'Moose::Meta::TypeConstraint';
  19
  20     sub my_custom_method {
  21         return 1;
  22     }
  23 }
  24
  25 my $Int = find_type_constraint('Int');
  26 ok $Int, 'Got a good type contstraint';
  27
  28 my $parent  = Test::Moose::Meta::TypeConstraint::AnySubType->new({
  29                 name => "Test::Moose::Meta::TypeConstraint::AnySubType" ,
  30                 parent => $Int,
  31 });
  32
  33 ok $parent, 'Created type constraint';
  34 ok $parent->check(1), 'Correctly passed';
  35 ok ! $parent->check('a'), 'correctly failed';
  36 ok $parent->my_custom_method, 'found the custom method';
  37
  38 my $subtype1 = subtype 'another_subtype' => as $parent;
  39
  40 ok $subtype1, 'Created type constraint';
  41 ok $subtype1->check(1), 'Correctly passed';
  42 ok ! $subtype1->check('a'), 'correctly failed';
  43 ok $subtype1->my_custom_method, 'found the custom method';
  44
  45
  46 my $subtype2 = subtype 'another_subtype' => as $subtype1 => where { $_ < 10 };
  47
  48 ok $subtype2, 'Created type constraint';
  49 ok $subtype2->check(1), 'Correctly passed';
  50 ok ! $subtype2->check('a'), 'correctly failed';
  51 ok ! $subtype2->check(100), 'correctly failed';
  52
  53 ok $subtype2->my_custom_method, 'found the custom method';
  54
  55
  56 {
  57     package Foo;
  58
  59     use Moose;
  60 }
  61
  62 {
  63     package Bar;
  64
  65     use Moose;
  66
  67     extends 'Foo';
  68 }
  69
  70 {
  71     package Baz;
  72
  73     use Moose;
  74 }
  75
  76 my $foo = class_type 'Foo';
  77 my $isa_foo = subtype 'IsaFoo' => as $foo;
  78
  79 ok $isa_foo, 'Created subtype of Foo type';
  80 ok $isa_foo->check( Foo->new ), 'Foo passes check';
  81 ok $isa_foo->check( Bar->new ), 'Bar passes check';
  82 ok ! $isa_foo->check( Baz->new ), 'Baz does not pass check';