From: Stevan Little <stevan.little@iinteractive.com>
Date: Mon, 24 Apr 2006 12:33:12 +0000 (+0000)
Subject: moose
X-Git-Tag: 0_05~5
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=cce8198ba52519eaf60ebb1121fb8304537cb4a5;p=gitmo%2FMoose.git

moose
---

diff --git a/Changes b/Changes
index 1cd0bcd..759ec1e 100644
--- a/Changes
+++ b/Changes
@@ -18,9 +18,10 @@ Revision history for Perl extension Moose
       - keywords are now exported with Sub::Exporter
 
     * Moose::Utils::TypeConstraints
-      - added several more types and restructured 
-        the hierarchy somewhat
-        - added tests for this
+      - reorganized the type constraint hierarchy, thanks
+        to nothingmuch and chansen for his help and advice 
+        on this
+        - added some tests for this
       - keywords are now exported with Sub::Exporter
         thanks chansen for this commit
 
@@ -32,12 +33,11 @@ Revision history for Perl extension Moose
       - due to changes in Class::MOP, we had to add the 
         initialize_instance_slot method (it's a good thing)
         
-    * Moose::Meta::TypeConstraints
+    * Moose::Meta::TypeConstraint
       - added type constraint unions 
         - added tests for this
-      - reorganized the type constraint hierarchy, thanks
-        to nothingmuch for his help and advice on this
-        - added some tests for this
+      - added the is_subtype_of predicate method
+        - added tests for this
 
 0.04 Sun. April 16th, 2006
     * Moose::Role
diff --git a/lib/Moose.pm b/lib/Moose.pm
index ddd0fc3..cd70131 100644
--- a/lib/Moose.pm
+++ b/lib/Moose.pm
@@ -380,7 +380,8 @@ If an attribute is marked as lazy it B<must> have a default supplied.
 The trigger option is a CODE reference which will be called after the value of 
 the attribute is set. The CODE ref will be passed the instance itself, the 
 updated value and the attribute meta-object (this is for more advanced fiddling
-and can typically be ignored in most cases).
+and can typically be ignored in most cases). You can B<not> have a trigger on 
+a read-only attribute.
 
 =back
 
diff --git a/lib/Moose/Meta/TypeConstraint.pm b/lib/Moose/Meta/TypeConstraint.pm
index 19aa9cb..e2109c6 100644
--- a/lib/Moose/Meta/TypeConstraint.pm
+++ b/lib/Moose/Meta/TypeConstraint.pm
@@ -78,6 +78,16 @@ sub validate {
     }
 }
 
+sub is_subtype_of {
+    my ($self, $type_name) = @_;
+    my $current = $self;
+    while (my $parent = $current->parent) {
+        return 1 if $parent->name eq $type_name;
+        $current = $parent;
+    }
+    return 0;
+}
+
 sub union {
     my ($class, @type_constraints) = @_;
     (scalar @type_constraints >= 2)
@@ -177,6 +187,8 @@ If you wish to use features at this depth, please come to the
 
 =item B<new>
 
+=item B<is_subtype_of>
+
 =item B<compile_type_constraint>
 
 =item B<check ($value)>
diff --git a/t/050_util_type_constraints.t b/t/050_util_type_constraints.t
index 6316806..bf8ef03 100644
--- a/t/050_util_type_constraints.t
+++ b/t/050_util_type_constraints.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 25;
+use Test::More tests => 32;
 use Test::Exception;
 
 use Scalar::Util ();
@@ -13,7 +13,7 @@ BEGIN {
 }
 
 type Number => where { Scalar::Util::looks_like_number($_) };
-type String => where { !ref($_) && !Num($_) };
+type String => where { !ref($_) && !Number($_) };
 
 subtype Natural 
 	=> as Number 
@@ -51,11 +51,18 @@ ok($negative->check(-5), '... this is a negative number');
 ok(!defined($negative->check(5)), '... this is not a negative number');
 is($negative->check('Foo'), undef, '... this is not a negative number');
 
+ok($negative->is_subtype_of('Number'), '... $negative is a subtype of Number');
+ok(!$negative->is_subtype_of('String'), '... $negative is not a subtype of String');
+
 # check some meta-details
 
 my $natural_less_than_ten = find_type_constraint('NaturalLessThanTen');
 isa_ok($natural_less_than_ten, 'Moose::Meta::TypeConstraint');
 
+ok($natural_less_than_ten->is_subtype_of('Natural'), '... NaturalLessThanTen is subtype of Natural');
+ok($natural_less_than_ten->is_subtype_of('Number'), '... NaturalLessThanTen is subtype of Number');
+ok(!$natural_less_than_ten->is_subtype_of('String'), '... NaturalLessThanTen is not subtype of String');
+
 ok($natural_less_than_ten->has_message, '... it has a message');
 
 ok(!defined($natural_less_than_ten->validate(5)), '... validated successfully (no error)');
@@ -67,6 +74,9 @@ is($natural_less_than_ten->validate(15),
 my $natural = find_type_constraint('Natural');
 isa_ok($natural, 'Moose::Meta::TypeConstraint');
 
+ok($natural->is_subtype_of('Number'), '... Natural is a subtype of Number');
+ok(!$natural->is_subtype_of('String'), '... Natural is not a subtype of String');
+
 ok(!$natural->has_message, '... it does not have a message');
 
 ok(!defined($natural->validate(5)), '... validated successfully (no error)');
diff --git a/t/053_util_find_type_constraint.t b/t/053_util_find_type_constraint.t
index b492250..5756cb8 100644
--- a/t/053_util_find_type_constraint.t
+++ b/t/053_util_find_type_constraint.t
@@ -32,4 +32,7 @@ foreach my $type_name (qw(
     is(find_type_constraint($type_name)->name, 
        $type_name, 
        '... got the right name for ' . $type_name);
-}
\ No newline at end of file
+}
+
+# TODO:
+# add tests for is_subtype_of which confirm the hierarchy
\ No newline at end of file