Check if it's optional, not if it accepts undef.
Florian Ragwitz [Wed, 3 Feb 2010 05:58:43 +0000 (06:58 +0100)]
lib/MooseX/Types/Structured.pm

index d534f44..6b9dd57 100644 (file)
@@ -746,6 +746,32 @@ 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",
@@ -777,7 +803,7 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
                                        }
                                } else {
                     ## Test to see 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;
@@ -805,34 +831,6 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
        )
 );
 
-OPTIONAL: {
-    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);
-}
-
 sub slurpy ($) {
        my ($tc) = @_;
        return MooseX::Types::Structured::OverflowHandler->new(