t/040_type_constraints/020_class_type_constraint.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More 'no_plan';
   7
   8 BEGIN {
   9     use_ok('Moose::Util::TypeConstraints');
  10 }
  11
  12 {
  13     package Gorch;
  14     use Moose;
  15
  16     package Bar;
  17     use Moose;
  18
  19     package Foo;
  20     use Moose;
  21
  22     extends qw(Bar Gorch);
  23 }
  24
  25 my $type = find_type_constraint("Foo");
  26
  27 ok( $type->is_subtype_of("Gorch"), "subtype of gorch" );
  28
  29 ok( $type->is_subtype_of("Bar"), "subtype of bar" );
  30
  31 ok( $type->is_subtype_of("Object"), "subtype of Object" );
  32
  33 ok( find_type_constraint("Bar")->check(Foo->new), "Foo passes Bar" );
  34 ok( find_type_constraint("Bar")->check(Bar->new), "Bar passes Bar" );
  35 ok( !find_type_constraint("Gorch")->check(Bar->new), "but Bar doesn't pass Gorch");
  36