[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