$args{name} = '__ANON__' if !defined $args{name};
- my $check = delete $args{optimized};
+ if($args{parent}) {
+ %args = (%{$args{parent}}, %args);
+ # a child type must not inherit 'compiled_type_constraint'
+ # and 'hand_optimized_type_constraint' from the parent
+ delete $args{compiled_type_constraint};
+ delete $args{hand_optimized_type_constraint};
+ }
+
+ my $check;
- if($check){
+ if($check = delete $args{optimized}) {
$args{hand_optimized_type_constraint} = $check;
$args{compiled_type_constraint} = $check;
}
-
- $check = $args{constraint};
+ elsif(my $param = $args{type_parameter}) {
+ my $generator = $args{constraint_generator}
+ || $class->throw_error("The $args{name} constraint cannot be used,"
+ . " because $param doesn't subtype from a parameterizable type");
+ # it must be 'constraint'
+ $check = $args{constraint} = $generator->($param);
+ }
+ else {
+ $check = $args{constraint};
+ }
if(defined($check) && ref($check) ne 'CODE'){
$class->throw_error(
my $self = bless \%args, $class;
$self->compile_type_constraint()
- if !$self->{hand_optimized_type_constraint};
+ if !$args{hand_optimized_type_constraint};
- $self->_compile_union_type_coercion() if $self->{type_constraints};
+ if($args{type_constraints}) {
+ $self->_compile_union_type_coercion();
+ }
return $self;
}
sub create_child_type{
my $self = shift;
return ref($self)->new(
- # a child inherits its parent's attributes
- %{$self},
-
- # but does not inherit 'compiled_type_constraint'
- # and 'hand_optimized_type_constraint'
- compiled_type_constraint => undef,
- hand_optimized_type_constraint => undef,
-
- # and is given child-specific args, of course.
@_,
-
- # and its parent
+ # and inherits other attributes from the parent
parent => $self,
);
}
}
$name ||= sprintf '%s[%s]', $self->name, $param->name;
-
- my $generator = $self->{constraint_generator}
- || $self->throw_error("The $name constraint cannot be used,"
- . " because $param doesn't subtype from a parameterizable type");
-
return Mouse::Meta::TypeConstraint->new(
name => $name,
parent => $self,
type_parameter => $param,
- constraint => $generator->($param), # must be 'constraint', not 'optimized'
);
}
sub duck_type {
my($name, @methods);
- if(!(@_ == 1 && ref($_[0]) eq 'ARRAY')){
+ if(ref($_[0]) ne 'ARRAY'){
$name = shift;
}
return _create_type 'subtype', $name => (
as => 'Object',
optimized_as => Mouse::Util::generate_can_predicate_for(\@methods),
+ message => sub {
+ my($object) = @_;
+ my @missing = grep { !$object->can($_) } @methods;
+ return ref($object)
+ . ' is missing methods '
+ . Mouse::Util::quoted_english_list(@missing);
+ },
);
}
--- /dev/null
+#!/usr/bin/perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+
+{
+ package Foo;
+
+ use Mouse::Util::TypeConstraints;
+
+ eval {
+ type MyRef => where { ref($_) };
+ };
+ ::ok( !$@, '... successfully exported &type to Foo package' );
+
+ eval {
+ subtype MyArrayRef => as MyRef => where { ref($_) eq 'ARRAY' };
+ };
+ ::ok( !$@, '... successfully exported &subtype to Foo package' );
+
+ Mouse::Util::TypeConstraints->export_type_constraints_as_functions();
+
+ ::ok( MyRef( {} ), '... Ref worked correctly' );
+ ::ok( MyArrayRef( [] ), '... ArrayRef worked correctly' );
+}
+
+done_testing;
#!/usr/bin/perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
use strict;
use warnings;
use Test::More;
use Test::Exception;
-use t::lib::MooseCompat;
use Scalar::Util ();
BEGIN {
ok(!defined ScalarRef({}), '... ScalarRef rejects anything which is not a ScalarRef');
ok(!defined ScalarRef(sub {}), '... ScalarRef rejects anything which is not a ScalarRef');
ok(defined ScalarRef($SCALAR_REF), '... ScalarRef accepts anything which is a ScalarRef');
+ok(defined ScalarRef(\$SCALAR_REF), '... ScalarRef accepts references to references');
ok(!defined ScalarRef($GLOB), '... ScalarRef rejects anything which is not a ScalarRef');
ok(!defined ScalarRef($GLOB_REF), '... ScalarRef rejects anything which is not a ScalarRef');
ok(!defined ScalarRef($fh), '... ScalarRef rejects anything which is not a ScalarRef');
--- /dev/null
+#!/usr/bin/perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
+
+use strict;
+use warnings;
+
+use lib 't/lib', 'lib';
+
+use Test::More;
+use Test::Exception;
+
+
+$SIG{__WARN__} = sub { 0 };
+
+eval { require Foo; };
+ok(!$@, '... loaded Foo successfully') || diag $@;
+
+delete $INC{'Foo.pm'};
+
+eval { require Foo; };
+ok(!$@, '... re-loaded Foo successfully') || diag $@;
+
+eval { require Bar; };
+ok(!$@, '... loaded Bar successfully') || diag $@;
+
+delete $INC{'Bar.pm'};
+
+eval { require Bar; };
+ok(!$@, '... re-loaded Bar successfully') || diag $@;
+
+done_testing;
#!/usr/bin/perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
use strict;
use warnings;
-use Test::More tests => 25;
+use Test::More;
use Test::Exception;
-
{
package HTTPHeader;
use Mouse;
Engine->new(header => \(my $var));
} '... dies correctly with bad params';
+done_testing;
#!/usr/bin/perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
use strict;
use warnings;
use Test::More;
use Test::Exception;
-BEGIN {
- eval "use IO::String; use IO::File;";
- plan skip_all => "IO::String and IO::File are required for this test" if $@;
- plan tests => 28;
-}
-
-
+use Test::Requires {
+ 'IO::String' => '0.01', # skip all if not installed
+ 'IO::File' => '0.01',
+};
{
package Email::Mouse;
# create the alias
- my $st = subtype 'IO::StringOrFile' => as 'IO::String | IO::File';
- #::diag $st->dump;
+ subtype 'IO::StringOrFile' => as 'IO::String | IO::File';
# attributes
sub as_string {
my ($self) = @_;
my $fh = $self->raw_body();
-
return do { local $/; <$fh> };
}
}
is($email->raw_body, $fh, '... and it is the one we expected');
}
+{
+ package Foo;
+
+ use Mouse;
+ use Mouse::Util::TypeConstraints;
+
+ subtype 'Coerced' => as 'ArrayRef';
+ coerce 'Coerced'
+ => from 'Value'
+ => via { [ $_ ] };
+
+ has carray => (
+ is => 'ro',
+ isa => 'Coerced | Coerced',
+ coerce => 1,
+ );
+}
+
+{
+ my $foo;
+ lives_ok { $foo = Foo->new( carray => 1 ) }
+ 'Can pass non-ref value for carray';
+ is_deeply(
+ $foo->carray, [1],
+ 'carray was coerced to an array ref'
+ );
+ throws_ok { Foo->new( carray => {} ) }
+ qr/\QValidation failed for 'Coerced|Coerced' with value \E(?!undef)/,
+ 'Cannot pass a hash ref for carray attribute, and hash ref is not coerced to an undef';
+}
+done_testing;
--- /dev/null
+#!/usr/bin/perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+
+BEGIN {
+ use_ok('Mouse::Util::TypeConstraints');
+ use_ok('Mouse::Meta::TypeConstraint');
+}
+
+# Array of Ints
+
+my $array_of_ints = Mouse::Meta::TypeConstraint->new(
+ name => 'ArrayRef[Int]',
+ parent => find_type_constraint('ArrayRef'),
+ type_parameter => find_type_constraint('Int'),
+);
+isa_ok($array_of_ints, 'Mouse::Meta::TypeConstraint');
+isa_ok($array_of_ints, 'Mouse::Meta::TypeConstraint');
+
+ok($array_of_ints->check([ 1, 2, 3, 4 ]), '... [ 1, 2, 3, 4 ] passed successfully');
+ok(!$array_of_ints->check([qw/foo bar baz/]), '... [qw/foo bar baz/] failed successfully');
+ok(!$array_of_ints->check([ 1, 2, 3, qw/foo bar/]), '... [ 1, 2, 3, qw/foo bar/] failed successfully');
+
+ok(!$array_of_ints->check(1), '... 1 failed successfully');
+ok(!$array_of_ints->check({}), '... {} failed successfully');
+ok(!$array_of_ints->check(sub { () }), '... sub { () } failed successfully');
+
+# Hash of Ints
+
+my $hash_of_ints = Mouse::Meta::TypeConstraint->new(
+ name => 'HashRef[Int]',
+ parent => find_type_constraint('HashRef'),
+ type_parameter => find_type_constraint('Int'),
+);
+isa_ok($hash_of_ints, 'Mouse::Meta::TypeConstraint');
+isa_ok($hash_of_ints, 'Mouse::Meta::TypeConstraint');
+
+ok($hash_of_ints->check({ one => 1, two => 2, three => 3 }), '... { one => 1, two => 2, three => 3 } passed successfully');
+ok(!$hash_of_ints->check({ 1 => 'one', 2 => 'two', 3 => 'three' }), '... { 1 => one, 2 => two, 3 => three } failed successfully');
+ok(!$hash_of_ints->check({ 1 => 'one', 2 => 'two', three => 3 }), '... { 1 => one, 2 => two, three => 3 } failed successfully');
+
+ok(!$hash_of_ints->check(1), '... 1 failed successfully');
+ok(!$hash_of_ints->check([]), '... [] failed successfully');
+ok(!$hash_of_ints->check(sub { () }), '... sub { () } failed successfully');
+
+# Array of Array of Ints
+
+my $array_of_array_of_ints = Mouse::Meta::TypeConstraint->new(
+ name => 'ArrayRef[ArrayRef[Int]]',
+ parent => find_type_constraint('ArrayRef'),
+ type_parameter => $array_of_ints,
+);
+isa_ok($array_of_array_of_ints, 'Mouse::Meta::TypeConstraint');
+isa_ok($array_of_array_of_ints, 'Mouse::Meta::TypeConstraint');
+
+ok($array_of_array_of_ints->check(
+ [[ 1, 2, 3 ], [ 4, 5, 6 ]]
+), '... [[ 1, 2, 3 ], [ 4, 5, 6 ]] passed successfully');
+ok(!$array_of_array_of_ints->check(
+ [[ 1, 2, 3 ], [ qw/foo bar/ ]]
+), '... [[ 1, 2, 3 ], [ qw/foo bar/ ]] failed successfully');
+
+{
+ my $anon_type = Mouse::Util::TypeConstraints::find_or_parse_type_constraint('ArrayRef[Foo]');
+ isa_ok( $anon_type, 'Mouse::Meta::TypeConstraint' );
+
+ my $param_type = $anon_type->type_parameter;
+ isa_ok( $param_type, 'Mouse::Meta::TypeConstraint' );
+}
+
+done_testing;
#!/usr/bin/perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
use strict;
use warnings;
-use Test::More tests => 19;
+use Test::More;
use Test::Exception;
BEGIN {
is($t->name, 'MyCollections', '... name is correct');
my $p = $t->parent;
-# isa_ok($p, 'Mouse::Meta::TypeConstraint::Union');
+ isa_ok($p, 'Mouse::Meta::TypeConstraint');
isa_ok($p, 'Mouse::Meta::TypeConstraint');
is($p->name, 'ArrayRef|HashRef', '... parent name is correct');
is($t->name, 'MyCollectionsExtended', '... name is correct');
my $p = $t->parent;
-# isa_ok($p, 'Mouse::Meta::TypeConstraint::Union');
+ isa_ok($p, 'Mouse::Meta::TypeConstraint');
isa_ok($p, 'Mouse::Meta::TypeConstraint');
is($p->name, 'ArrayRef|HashRef', '... parent name is correct');
ok(!$t->check(1), '... validated it correctly');
}
-
+done_testing;
--- /dev/null
+#!/usr/bin/perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+
+BEGIN {
+ use_ok("Mouse::Util::TypeConstraints");
+ use_ok('Mouse::Meta::TypeConstraint');
+}
+
+lives_ok {
+ subtype 'AlphaKeyHash' => as 'HashRef'
+ => where {
+ # no keys match non-alpha
+ (grep { /[^a-zA-Z]/ } keys %$_) == 0
+ };
+} '... created the subtype special okay';
+
+lives_ok {
+ subtype 'Trihash' => as 'AlphaKeyHash'
+ => where {
+ keys(%$_) == 3
+ };
+} '... created the subtype special okay';
+
+lives_ok {
+ subtype 'Noncon' => as 'Item';
+} '... created the subtype special okay';
+
+{
+ my $t = find_type_constraint('AlphaKeyHash');
+ isa_ok($t, 'Mouse::Meta::TypeConstraint');
+
+ is($t->name, 'AlphaKeyHash', '... name is correct');
+
+ my $p = $t->parent;
+ isa_ok($p, 'Mouse::Meta::TypeConstraint');
+
+ is($p->name, 'HashRef', '... parent name is correct');
+
+ ok($t->check({ one => 1, two => 2 }), '... validated it correctly');
+ ok(!$t->check({ one1 => 1, two2 => 2 }), '... validated it correctly');
+
+ local $TODO = 'Mouse does not support equals()';
+ ok( $t->equals($t), "equals to self" );
+ ok( !$t->equals($t->parent), "not equal to parent" );
+}
+
+my $hoi = Mouse::Util::TypeConstraints::find_or_parse_type_constraint('AlphaKeyHash[Int]');
+
+ok($hoi->check({ one => 1, two => 2 }), '... validated it correctly');
+ok(!$hoi->check({ one1 => 1, two2 => 2 }), '... validated it correctly');
+ok(!$hoi->check({ one => 'uno', two => 'dos' }), '... validated it correctly');
+ok(!$hoi->check({ one1 => 'un', two2 => 'deux' }), '... validated it correctly');
+{ local $TODO = 'Mouse does not support equals()';
+ok( $hoi->equals($hoi), "equals to self" );
+ok( !$hoi->equals($hoi->parent), "equals to self" );
+ok( !$hoi->equals(find_type_constraint('AlphaKeyHash')), "not equal to unparametrized self" );
+ok( $hoi->equals( Mouse::Meta::TypeConstraint->new( name => "Blah", parent => find_type_constraint("AlphaKeyHash"), type_parameter => find_type_constraint("Int") ) ), "equal to clone" );
+ok( !$hoi->equals( Mouse::Meta::TypeConstraint->new( name => "Oink", parent => find_type_constraint("AlphaKeyHash"), type_parameter => find_type_constraint("Str") ) ), "not equal to different parameter" );
+} # end TODO
+
+my $th = Mouse::Util::TypeConstraints::find_or_parse_type_constraint('Trihash[Bool]');
+ok(!$th->check({ one => 1, two => 1 }), '... validated it correctly');
+ok($th->check({ one => 1, two => 0, three => 1 }), '... validated it correctly');
+ok(!$th->check({ one => 1, two => 2, three => 1 }), '... validated it correctly');
+ok(!$th->check({foo1 => 1, bar2 => 0, baz3 => 1}), '... validated it correctly');
+
+dies_ok {
+ Mouse::Meta::TypeConstraint->new(
+ name => 'Str[Int]',
+ parent => find_type_constraint('Str'),
+ type_parameter => find_type_constraint('Int'),
+ );
+} 'non-containers cannot be parameterized';
+
+dies_ok {
+ Mouse::Meta::TypeConstraint->new(
+ name => 'Noncon[Int]',
+ parent => find_type_constraint('Noncon'),
+ type_parameter => find_type_constraint('Int'),
+ );
+} 'non-containers cannot be parameterized';
+
+done_testing;
#!/usr/bin/perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
use strict;
use warnings;
-use Test::More tests => 9;
+use Test::More;
use Test::Exception;
{
qr/This number \(0\) is not less than ten!/,
'gave custom supertype error message on lazy set to 0';
+done_testing;
#!/usr/bin/perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
use strict;
use warnings;
-use Test::More tests => 54;
+use Test::More;
use Test::Exception;
-use t::lib::MooseCompat;
{
package Foo;
ok( Undef(undef), '... undef is a Undef');
ok(!Defined(undef), '... undef is NOT a Defined');
-ok(!Int(undef), '... undef is NOT a Int');
+ok(!Int(undef), '... undef is NOT an Int');
ok(!Number(undef), '... undef is NOT a Number');
ok(!Str(undef), '... undef is NOT a Str');
ok(!String(undef), '... undef is NOT a String');
ok(!Undef(5), '... 5 is a NOT a Undef');
ok(Defined(5), '... 5 is a Defined');
-ok(Int(5), '... 5 is a Int');
+ok(Int(5), '... 5 is an Int');
ok(Number(5), '... 5 is a Number');
ok(Str(5), '... 5 is a Str');
ok(!String(5), '... 5 is NOT a String');
ok(!Undef(0.5), '... 0.5 is a NOT a Undef');
ok(Defined(0.5), '... 0.5 is a Defined');
-ok(!Int(0.5), '... 0.5 is NOT a Int');
+ok(!Int(0.5), '... 0.5 is NOT an Int');
ok(Number(0.5), '... 0.5 is a Number');
ok(Str(0.5), '... 0.5 is a Str');
ok(!String(0.5), '... 0.5 is NOT a String');
ok(!Undef('Foo'), '... "Foo" is NOT a Undef');
ok(Defined('Foo'), '... "Foo" is a Defined');
-ok(!Int('Foo'), '... "Foo" is NOT a Int');
+ok(!Int('Foo'), '... "Foo" is NOT an Int');
ok(!Number('Foo'), '... "Foo" is NOT a Number');
ok(Str('Foo'), '... "Foo" is a Str');
ok(String('Foo'), '... "Foo" is a String');
dies_ok { $foo->v_lazy_Str() } '... undef is NOT a Foo->Str';
dies_ok { $foo->v_lazy_String() } '... undef is NOT a Foo->String';
-
-
-
+done_testing;
#!/usr/bin/perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
use strict;
use warnings;
-use Test::More tests => 1;
+use Test::More;
{
package SomeClass;
=> where { /^6$/ };
subtype 'TextSix' => as 'Str'
=> where { /Six/i };
-
coerce 'TextSix'
=> from 'DigitSix'
=> via { confess("Cannot live without 6 ($_)") unless /^6$/; 'Six' };
);
}
+my $attr = SomeClass->meta->get_attribute('foo');
+is($attr->get_value(SomeClass->new()), 'Six');
is(SomeClass->new()->foo, 'Six');
-
+done_testing;
--- /dev/null
+#!/usr/bin/perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+
+BEGIN {
+ use_ok('Mouse::Util::TypeConstraints');
+}
+
+# testing the parameterize method
+
+{
+ my $parameterizable = subtype 'parameterizable_hashref', as 'HashRef';
+
+ my $parameterized = subtype 'parameterized_hashref', as 'HashRef[Int]';
+
+ my $int = Mouse::Util::TypeConstraints::find_type_constraint('Int');
+
+ my $from_parameterizable = $parameterizable->parameterize($int);
+
+ isa_ok $parameterizable,
+ 'Mouse::Meta::TypeConstraint', =>
+ 'Got expected type instance';
+
+ package Test::Mouse::Meta::TypeConstraint;
+ use Mouse;
+
+ has parameterizable => ( is => 'rw', isa => $parameterizable );
+ has parameterized => ( is => 'rw', isa => $parameterized );
+ has from_parameterizable => ( is => 'rw', isa => $from_parameterizable );
+}
+
+# Create and check a dummy object
+
+ok my $params = Test::Mouse::Meta::TypeConstraint->new() =>
+ 'Create Dummy object for testing';
+
+isa_ok $params, 'Test::Mouse::Meta::TypeConstraint' =>
+ 'isa correct type';
+
+# test parameterizable
+
+lives_ok sub {
+ $params->parameterizable( { a => 'Hello', b => 'World' } );
+} => 'No problem setting parameterizable';
+
+is_deeply $params->parameterizable,
+ { a => 'Hello', b => 'World' } => 'Got expected values';
+
+# test parameterized
+
+lives_ok sub {
+ $params->parameterized( { a => 1, b => 2 } );
+} => 'No problem setting parameterized';
+
+is_deeply $params->parameterized, { a => 1, b => 2 } => 'Got expected values';
+
+throws_ok sub {
+ $params->parameterized( { a => 'Hello', b => 'World' } );
+ }, qr/Attribute \(parameterized\) does not pass the type constraint/ =>
+ 'parameterized throws expected error';
+
+# test from_parameterizable
+
+lives_ok sub {
+ $params->from_parameterizable( { a => 1, b => 2 } );
+} => 'No problem setting from_parameterizable';
+
+is_deeply $params->from_parameterizable,
+ { a => 1, b => 2 } => 'Got expected values';
+
+throws_ok sub {
+ $params->from_parameterizable( { a => 'Hello', b => 'World' } );
+ },
+ qr/Attribute \(from_parameterizable\) does not pass the type constraint/
+ => 'from_parameterizable throws expected error';
+
+done_testing;
#!/usr/bin/perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
use strict;
use warnings;
-use Test::More tests => 2;
+use Test::More;
use Test::Exception;
BEGIN {
subtype 'MySubType' => as 'Int' => where { 1 };
} qr/cannot be created again/, 'Trying to create same type twice throws';
+done_testing;
--- /dev/null
+#!/usr/bin/perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
+
+use strict;
+use warnings;
+
+use Test::More;
+
+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',
+ 'parent type constraint is a class type' );
+
+done_testing;
--- /dev/null
+use strict;
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
+use warnings;
+
+use Test::More;
+$TODO = q{Mouse is not yet completed};
+
+use Mouse::Util::TypeConstraints;
+
+
+eval { Mouse::Util::TypeConstraints::create_type_constraint_union() };
+
+like( $@, qr/\QYou must pass in at least 2 type names to make a union/,
+ 'can throw a proper error without Mouse being loaded by the caller' );
+
+done_testing;
--- /dev/null
+#!/usr/bin/perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+
+{
+
+ package Duck;
+ use Mouse;
+
+ sub quack { }
+
+}
+
+{
+
+ package Swan;
+ use Mouse;
+
+ sub honk { }
+
+}
+
+{
+
+ package RubberDuck;
+ use Mouse;
+
+ sub quack { }
+
+}
+
+{
+
+ package DucktypeTest;
+ use Mouse;
+ use Mouse::Util::TypeConstraints;
+
+ duck_type 'DuckType' => qw(quack);
+ duck_type 'SwanType' => [qw(honk)];
+
+ has duck => (
+ isa => 'DuckType',
+ is => 'ro',
+ lazy_build => 1,
+ );
+
+ sub _build_duck { Duck->new }
+
+ has swan => (
+ isa => duck_type( [qw(honk)] ),
+ is => 'ro',
+ );
+
+ has other_swan => (
+ isa => 'SwanType',
+ is => 'ro',
+ );
+
+}
+
+# try giving it a duck
+lives_ok { DucktypeTest->new( duck => Duck->new ) } 'the Duck lives okay';
+
+# try giving it a swan which is like a duck, but not close enough
+throws_ok { DucktypeTest->new( duck => Swan->new ) }
+qr/Swan is missing methods 'quack'/,
+ "the Swan doesn't quack";
+
+# try giving it a rubber RubberDuckey
+lives_ok { DucktypeTest->new( swan => Swan->new ) } 'but a Swan can honk';
+
+# try giving it a rubber RubberDuckey
+lives_ok { DucktypeTest->new( duck => RubberDuck->new ) }
+'the RubberDuck lives okay';
+
+# try with the other constraint form
+lives_ok { DucktypeTest->new( other_swan => Swan->new ) } 'but a Swan can honk';
+
+done_testing;
projects / gitmo/Mouse.git / commitdiff