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 => 16;
   7 use Test::Exception;
   8
   9 BEGIN {
  10     use_ok('Moose::Util::TypeConstraints');
  11     use_ok('Moose::Meta::TypeConstraint');
  12 }
  13
  14 ## Create a subclass with a custom method
  15
  16 {
  17     package Test::Moose::Meta::TypeConstraint::AnySubType;
  18     use Moose;
  19     extends 'Moose::Meta::TypeConstraint';
  20
  21     sub my_custom_method {
  22         return 1;
  23     }
  24 }
  25
  26 my $Int = Moose::Util::TypeConstraints::find_type_constraint('Int');
  27 ok $Int, 'Got a good type contstraint';
  28
  29 my $parent  = Test::Moose::Meta::TypeConstraint::AnySubType->new({
  30                 name => "Test::Moose::Meta::TypeConstraint::AnySubType" ,
  31                 parent => $Int,
  32 });
  33
  34 ok $parent, 'Created type constraint';
  35 ok $parent->check(1), 'Correctly passed';
  36 ok ! $parent->check('a'), 'correctly failed';
  37 ok $parent->my_custom_method, 'found the custom method';
  38
  39 my $subtype1 = Moose::Util::TypeConstraints::subtype 'another_subtype',
  40     as $parent;
  41
  42 ok $subtype1, 'Created type constraint';
  43 ok $subtype1->check(1), 'Correctly passed';
  44 ok ! $subtype1->check('a'), 'correctly failed';
  45 ok $subtype1->my_custom_method, 'found the custom method';
  46
  47
  48 my $subtype2 = Moose::Util::TypeConstraints::subtype 'another_subtype',
  49     as $subtype1,
  50     where { $_ < 10 };
  51
  52 ok $subtype2, 'Created type constraint';
  53 ok $subtype2->check(1), 'Correctly passed';
  54 ok ! $subtype2->check('a'), 'correctly failed';
  55 ok ! $subtype2->check(100), 'correctly failed';
  56
  57 ok $subtype2->my_custom_method, 'found the custom method';