[libtype-tiny-perl] 18/27: better implementations of is_subtype_of/is_strictly_subtype_of, more subclassable

[Jonas Smedegaard]

This is an automated email from the git hooks/post-receive script.

js pushed a commit to branch master
in repository libtype-tiny-perl.

commit a7b746a2b7e45fad5ff29e0b6f644eaa2faf67e8
Author: Toby Inkster <mail at tobyinkster.co.uk>
Date:   Tue Aug 6 08:31:36 2013 +0100

    better implementations of is_subtype_of/is_strictly_subtype_of, more subclassable
---
 lib/Type/Tiny.pm |   34 ++++++++++++++++++++--------------
 1 file changed, 20 insertions(+), 14 deletions(-)

diff --git a/lib/Type/Tiny.pm b/lib/Type/Tiny.pm
index b99e891..f8eabc9 100644
--- a/lib/Type/Tiny.pm
+++ b/lib/Type/Tiny.pm
@@ -337,13 +337,16 @@ sub is_subtype_of
 	return unless blessed($self)  && $self->isa("Type::Tiny");
 	return unless blessed($other) && $other->isa("Type::Tiny");
 
-	my $this = $self;
-	while (my $parent = $this->parent)
-	{
-		return !!1 if $parent->equals($other);
-		$this = $parent;
-	}
-	return;
+#	my $this = $self;
+#	while (my $parent = $this->parent)
+#	{
+#		return !!1 if $parent->equals($other);
+#		$this = $parent;
+#	}
+#	return;
+
+	return unless $self->has_parent;	
+	$self->parent->equals($other) or $self->parent->is_subtype_of($other);
 }
 
 sub is_supertype_of
@@ -378,13 +381,16 @@ sub is_strictly_subtype_of
 	return unless blessed($self)  && $self->isa("Type::Tiny");
 	return unless blessed($other) && $other->isa("Type::Tiny");
 
-	my $this = $self;
-	while (my $parent = $this->parent)
-	{
-		return !!1 if $parent->strictly_equals($other);
-		$this = $parent;
-	}
-	return;
+#	my $this = $self;
+#	while (my $parent = $this->parent)
+#	{
+#		return !!1 if $parent->strictly_equals($other);
+#		$this = $parent;
+#	}
+#	return;
+
+	return unless $self->has_parent;	
+	$self->parent->strictly_equals($other) or $self->parent->is_strictly_subtype_of($other);
 }
 
 sub is_strictly_supertype_of

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libtype-tiny-perl.git