[gitmo/Mouse.git] / t / 040_type_constraints / failing / 031_subtype_auto_vivify_parent.t

#!/usr/bin/perl

use strict;
use warnings;

use Test::More tests => 4;

use Mouse::Util::TypeConstraints;


{
    package Foo;

    sub new {
        my $class = shift;

        return bless {@_}, $class;
    }
}

subtype 'FooWithSize'
    => as 'Foo'
    => where { $_[0]->{size} };


my $type = find_type_constraint('FooWithSize');
ok( $type,         'made a FooWithSize constraint' );
ok( $type->parent, 'type has a parent type' );
is( $type->parent->name, 'Foo', 'parent type is Foo' );
isa_ok( $type->parent, 'Mouse::Meta::TypeConstraint::Class',
        'parent type constraint is a class type' );
Commit	Line	Data
b2b106d7	1	#!/usr/bin/perl
	2
	3	use strict;
	4	use warnings;
	5
	6	use Test::More tests => 4;
	7
	8	use Mouse::Util::TypeConstraints;
	9
	10
	11	{
	12	package Foo;
	13
	14	sub new {
	15	my $class = shift;
	16
	17	return bless {@_}, $class;
	18	}
	19	}
	20
	21	subtype 'FooWithSize'
	22	=> as 'Foo'
	23	=> where { $_[0]->{size} };
	24
	25
	26	my $type = find_type_constraint('FooWithSize');
	27	ok( $type, 'made a FooWithSize constraint' );
	28	ok( $type->parent, 'type has a parent type' );
	29	is( $type->parent->name, 'Foo', 'parent type is Foo' );
	30	isa_ok( $type->parent, 'Mouse::Meta::TypeConstraint::Class',
	31	'parent type constraint is a class type' );