[libtype-tiny-perl] 03/11: implement equals for Union types by checking if they're the union of the same things; also overload numeric-not-equal operator
Jonas Smedegaard
dr at jones.dk
Wed Oct 29 19:42:47 UTC 2014
This is an automated email from the git hooks/post-receive script.
js pushed a commit to tag 1.001_002
in repository libtype-tiny-perl.
commit 2c4d9ebb51f0ec879dc6873284737bf1250ec64b
Author: Toby Inkster <mail at tobyinkster.co.uk>
Date: Tue Sep 30 22:20:53 2014 +0100
implement equals for Union types by checking if they're the union of the same things; also overload numeric-not-equal operator
---
lib/Type/Tiny.pm | 1 +
lib/Type/Tiny/Union.pm | 26 ++++++++++++++++++++++++++
t/20-unit/Type-Tiny-Union/basic.t | 10 ++++++++++
3 files changed, 37 insertions(+)
diff --git a/lib/Type/Tiny.pm b/lib/Type/Tiny.pm
index 146803f..542e284 100644
--- a/lib/Type/Tiny.pm
+++ b/lib/Type/Tiny.pm
@@ -77,6 +77,7 @@ use overload
},
q(~) => sub { shift->complementary_type },
q(==) => sub { $_[0]->equals($_[1]) },
+ q(!=) => sub { not $_[0]->equals($_[1]) },
q(<) => sub { my $m = $_[0]->can('is_subtype_of'); $m->(_swap @_) },
q(>) => sub { my $m = $_[0]->can('is_subtype_of'); $m->(reverse _swap @_) },
q(<=) => sub { my $m = $_[0]->can('is_a_type_of'); $m->(_swap @_) },
diff --git a/lib/Type/Tiny/Union.pm b/lib/Type/Tiny/Union.pm
index 31dab42..9266273 100644
--- a/lib/Type/Tiny/Union.pm
+++ b/lib/Type/Tiny/Union.pm
@@ -187,6 +187,32 @@ sub validate_explain
];
}
+sub equals
+{
+ my ($self, $other) = Type::Tiny::_loose_to_TypeTiny(@_);
+ return unless blessed($self) && $self->isa("Type::Tiny");
+ return unless blessed($other) && $other->isa("Type::Tiny");
+
+ return !!1 if $self->SUPER::equals($other);
+ return !!0 unless $other->isa(__PACKAGE__);
+
+ my @self_constraints = @{ $self->type_constraints };
+ my @other_constraints = @{ $other->type_constraints };
+
+ return !!0 unless @self_constraints == @other_constraints;
+
+ constraint: foreach my $constraint ( @self_constraints ) {
+ for ( my $i = 0; $i < @other_constraints; $i++ ) {
+ if ( $constraint->equals($other_constraints[$i]) ) {
+ splice @other_constraints, $i, 1;
+ next constraint;
+ }
+ }
+ }
+
+ @other_constraints == 0;
+}
+
1;
__END__
diff --git a/t/20-unit/Type-Tiny-Union/basic.t b/t/20-unit/Type-Tiny-Union/basic.t
index 73d7aaa..22fc0fd 100644
--- a/t/20-unit/Type-Tiny-Union/basic.t
+++ b/t/20-unit/Type-Tiny-Union/basic.t
@@ -146,4 +146,14 @@ is(
'Union find_type_for (none)',
);
+ok(
+ (FooBar|DoesQuux)==(DoesQuux|FooBar),
+ 'Union equals',
+);
+
+ok(
+ (FooBar|DoesQuux)!=(DoesQuux|SmallInteger),
+ 'Union not equals',
+);
+
done_testing;
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libtype-tiny-perl.git
More information about the Pkg-perl-cvs-commits
mailing list