package Mouse::Meta::TypeConstraint;
use Mouse::Util qw(:meta); # enables strict and warnings
+use Scalar::Util ();
use overload
'bool' => sub (){ 1 }, # always true
'""' => sub { $_[0]->name }, # stringify to tc name
+ '0+' => sub { Scalar::Util::refaddr($_[0]) },
'|' => sub { # or-combination
require Mouse::Util::TypeConstraints;
return Mouse::Util::TypeConstraints::find_or_parse_type_constraint(
fallback => 1;
sub new {
- my($class, %args) = @_;
+ my $class = shift;
+ my %args = @_ == 1 ? %{$_[0]} : @_;
$args{name} = '__ANON__' if !defined $args{name};
use strict;
use warnings;
-use Test::More tests => 11;
+use Test::More;
use Test::Exception;
+use Scalar::Util qw(refaddr);
BEGIN {
use_ok('Mouse::Util::TypeConstraints');
"correct error thrown"
);
}
+
+{
+ for my $t (qw(Bar Foo)) {
+ my $tc = Mouse::Meta::TypeConstraint->new({
+ name => $t,
+ });
+
+ Mouse::Util::TypeConstraints::register_type_constraint($tc);
+ }
+
+ my $foo = Mouse::Util::TypeConstraints::find_type_constraint('Foo');
+ my $bar = Mouse::Util::TypeConstraints::find_type_constraint('Bar');
+
+ ok(!$foo->is_a_type_of($bar), "Foo type is not equal to Bar type");
+ ok( $foo->is_a_type_of($foo), "Foo equals Foo");
+ ok( 0+$foo == refaddr($foo), "overloading works");
+}
+
+ok $subtype1, "type constraint boolean overload works";
+
+done_testing;