From: Florian Ragwitz <rafl@debian.org>
Date: Wed, 3 Feb 2010 06:14:04 +0000 (+0100)
Subject: Same Optional[] fix, but for Tuple this time.
X-Git-Tag: 0.20~1^2~1
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMooseX-Types-Structured.git;a=commitdiff_plain;h=b86402a09c4f8f81b5f685e340c96d2361c742de

Same Optional[] fix, but for Tuple this time.
---

diff --git a/lib/MooseX/Types/Structured.pm b/lib/MooseX/Types/Structured.pm
index 6b9dd57..f5fb346 100644
--- a/lib/MooseX/Types/Structured.pm
+++ b/lib/MooseX/Types/Structured.pm
@@ -689,6 +689,32 @@ clean and declarative way.
 
 =cut
 
+my $Optional = Moose::Meta::TypeConstraint::Parameterizable->new(
+    name => 'MooseX::Types::Structured::Optional',
+    package_defined_in => __PACKAGE__,
+    parent => find_type_constraint('Item'),
+    constraint => sub { 1 },
+    constraint_generator => sub {
+        my ($type_parameter, @args) = @_;
+        my $check = $type_parameter->_compiled_type_constraint();
+        return sub {
+            my (@args) = @_;
+            ## Does the arg exist?  Something exists if it's a 'real' value
+            ## or if it is set to undef.
+            if(exists($args[0])) {
+                ## If it exists, we need to validate it
+                $check->($args[0]);
+            } else {
+                ## But it's is okay if the value doesn't exists
+                return 1;
+            }
+        }
+    }
+);
+
+Moose::Util::TypeConstraints::register_type_constraint($Optional);
+Moose::Util::TypeConstraints::add_parameterizable_type($Optional);
+
 Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
 	MooseX::Meta::TypeConstraint::Structured->new(
 		name => "MooseX::Types::Structured::Tuple" ,
@@ -718,7 +744,7 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
 					}
 				} else {
                     ## Test if the TC supports null values
-					unless($type_constraint->check()) {
+                    unless ($type_constraint->is_subtype_of($Optional)) {
                         $_[2]->{message} = $type_constraint->get_message('NULL')
                          if ref $_[2];
 						return;
@@ -746,32 +772,6 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
 	)
 );
 
-my $Optional = Moose::Meta::TypeConstraint::Parameterizable->new(
-    name => 'MooseX::Types::Structured::Optional',
-    package_defined_in => __PACKAGE__,
-    parent => find_type_constraint('Item'),
-    constraint => sub { 1 },
-    constraint_generator => sub {
-        my ($type_parameter, @args) = @_;
-        my $check = $type_parameter->_compiled_type_constraint();
-        return sub {
-            my (@args) = @_;
-            ## Does the arg exist?  Something exists if it's a 'real' value
-            ## or if it is set to undef.
-            if(exists($args[0])) {
-                ## If it exists, we need to validate it
-                $check->($args[0]);
-            } else {
-                ## But it's is okay if the value doesn't exists
-                return 1;
-            }
-        }
-    }
-);
-
-Moose::Util::TypeConstraints::register_type_constraint($Optional);
-Moose::Util::TypeConstraints::add_parameterizable_type($Optional);
-
 Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
 	MooseX::Meta::TypeConstraint::Structured->new(
 		name => "MooseX::Types::Structured::Dict",