all tests passing again after move to message stack

diff --git a/lib/MooseX/Meta/TypeConstraint/Structured.pm b/lib/MooseX/Meta/TypeConstraint/Structured.pm
index 33ed2c8..25b8c87 100644 (file)
--- a/lib/MooseX/Meta/TypeConstraint/Structured.pm
+++ b/lib/MooseX/Meta/TypeConstraint/Structured.pm
@@ -66,31 +66,29 @@ Messing with validate so that we can support niced error messages.
 =cut
 
 override 'validate' => sub {
-    my ($self, $value, $message) = @_;
-    $message = bless {message=>undef, level=>0}, 'MooseX::Types::Structured::Message'
-      unless $message;
+    my ($self, $value, $message_stack) = @_;
+    unless ($message_stack) {
+        $message_stack = MooseX::Types::Structured::MessageStack->new();
+    }
 
-    $message->{level}++;
+    $message_stack->inc_level;
 
-    if ($self->_compiled_type_constraint->($value, $message)) {
+    if ($self->_compiled_type_constraint->($value, $message_stack)) {
         ## Everything is good, no error message to return
         return undef;
     } else {
         ## Whoops, need to figure out the right error message
         my $args = Devel::PartialDump::dump($value);
-        if(my $messages = $message->{message}) {
-            my $level = $message->{level};
-            my $message_str = ref $messages ? join("\n".(" "x$level)."[+] ",reverse @$messages) : $messages;        
-            $message->{level}--;
-
-            if($message->{level}) {
+        $message_stack->dec_level;
+        if($message_stack->has_messages) {
+            if($message_stack->level) {
+                ## we are inside a deeply structured constraint
                 return $self->get_message($args);
             } else {
+                my $message_str = $message_stack->as_string;
                 return $self->get_message("$args, Internal Validation Error is: $message_str");
             }
         } else {
-            $message->{level}--;
-
             return $self->get_message($args);
         }
     }

diff --git a/lib/MooseX/Types/Structured.pm b/lib/MooseX/Types/Structured.pm
index c95ada8..228b51c 100644 (file)
--- a/lib/MooseX/Types/Structured.pm
+++ b/lib/MooseX/Types/Structured.pm
@@ -7,6 +7,7 @@ use Moose::Util::TypeConstraints 1.06;
 use MooseX::Meta::TypeConstraint::Structured;
 use MooseX::Meta::TypeConstraint::Structured::Optional;
 use MooseX::Types::Structured::OverflowHandler;
+use MooseX::Types::Structured::MessageStack;
 use MooseX::Types 0.22 -declare => [qw(Dict Map Tuple Optional)];
 use Sub::Exporter 0.982 -setup => [ qw(Dict Map Tuple Optional slurpy) ];
 use Devel::PartialDump 0.10;
@@ -744,21 +745,19 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
                 if(@values) {
                     my $value = shift @values;
                     unless($type_constraint->check($value)) {
-                        my $message = $type_constraint->validate($value,$_[2]);
-                        if(ref $_[2]) {
-                            push @{$_[2]->{message}}, $message
-                             if ref $_[2];
-                            return;
-                        } else {
-#warn "Don't know what to do with $message";
-return;
+                        if($_[2]) {
+                           my $message = $type_constraint->validate($value,$_[2]);
+                           $_[2]->add_message({message=>$message,level=>$_[2]->level});
                         }
+                        return;
                     }
                 } else {
                     ## Test if the TC supports null values
                     unless ($type_constraint->is_subtype_of($Optional)) {
-                        $_[2]->{message} = $type_constraint->get_message('NULL')
-                         if ref $_[2];
+                        if($_[2]) {
+                           my $message = $type_constraint->get_message('NULL',$_[2]);
+                           $_[2]->add_message({message=>$message,level=>$_[2]->level});
+                        }
                         return;
                     }
                 }
@@ -768,14 +767,17 @@ return;
                 if($overflow_handler) {
                     return $overflow_handler->check([@values], $_[2]);
                 } else {
-                    $_[2]->{message} = "More values than Type Constraints!"
-                     if ref $_[2];
+                    if($_[2]) {
+                        my $message = "More values than Type Constraints!";
+                        $_[2]->add_message({message=>$message,level=>$_[2]->level});
+                    }
                     return;
                 }
             } elsif(@type_constraints) {
-                $_[2]->{message} =
-                 "Not enough values for all defined type constraints.  Remaining: ". join(', ',@type_constraints)
-                 if ref $_[2];
+                if($_[2]) {
+                    my $message = "Not enough values for all defined type constraints.  Remaining: ". join(', ',@type_constraints);
+                    $_[2]->add_message({message=>$message,level=>$_[2]->level});
+                }
                 return;
             } else {
                 return 1;
@@ -809,21 +811,19 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
                     my $value = $values{$key};
                     delete $values{$key};
                     unless($type_constraint->check($value)) {
-                        my $message = $type_constraint->validate($value,$_[2]);
-                        if(ref $_[2]) {
-                            push @{$_[2]->{message}}, $message
-                             if ref $_[2];
-                            return;
-                        } else {
-#warn "Don't know what to do with $message";
-return;
+                        if($_[2]) {
+                            my $message = $type_constraint->validate($value,$_[2]);
+                            $_[2]->add_message({message=>$message,level=>$_[2]->level});
                         }
+                        return;
                     }
                 } else {
                     ## Test to see if the TC supports null values
                     unless ($type_constraint->is_subtype_of($Optional)) {
-                        $_[2]->{message} = $type_constraint->get_message('NULL')
-                         if ref $_[2];
+                        if($_[2]) {
+                           my $message = $type_constraint->get_message('NULL',$_[2]);
+                           $_[2]->add_message({message=>$message,level=>$_[2]->level});
+                        }
                         return;
                     }
                 }
@@ -833,14 +833,17 @@ return;
                 if($overflow_handler) {
                     return $overflow_handler->check(+{%values});
                 } else {
-                    $_[2]->{message} = "More values than Type Constraints!"
-                     if ref $_[2];
+                    if($_[2]) {
+                        my $message = "More values than Type Constraints!";
+                        $_[2]->add_message({message=>$message,level=>$_[2]->level});
+                    }
                     return;
                 }
             } elsif(%type_constraints) {
-                $_[2]->{message} =
-                 "Not enough values for all defined type constraints.  Remaining: ". join(', ',values %values)
-                 if ref $_[2];
+                if($_[2]) {
+                    my $message = "Not enough values for all defined type constraints.  Remaining: ". join(', ',@type_constraints);
+                    $_[2]->add_message({message=>$message,level=>$_[2]->level});
+                }
                 return;
             } else {
                 return 1;
@@ -869,7 +872,10 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
       if ($value_type) {
         for my $value (values %$values) {
           unless ($value_type->check($value)) {
-            $_[2]->{message} = $value_type->get_message($value) if ref $_[2];
+            if($_[2]) {
+              my $message = $value_type->validate($value,$_[2]);
+              $_[2]->add_message({message=>$message,level=>$_[2]->level});
+            }
             return;
           }
         }
@@ -878,7 +884,10 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
       if ($key_type) {
         for my $key (keys %$values) {
           unless ($key_type->check($key)) {
-            $_[2]->{message} = $key_type->get_message($key) if ref $_[2];
+            if($_[2]) {
+              my $message = $key_type->validate($key,$_[2]);
+              $_[2]->add_message({message=>$message,level=>$_[2]->level});
+            }
             return;
           }
         }

diff --git a/t/12-error.t b/t/12-error.t
index 404716d..acf8cd3 100644 (file)
--- a/t/12-error.t
+++ b/t/12-error.t
@@ -1,8 +1,6 @@
-BEGIN {
-    use strict;
-    use warnings;
-    use Test::More tests=>27;
-}
+use strict;
+use warnings;
+use Test::More;
 
 use Moose::Util::TypeConstraints;
 use MooseX::Types::Structured qw(Dict Tuple Optional);
@@ -135,35 +133,4 @@ like $deep_tuple->validate([1,{a=>2},{name=>'Vincent1',age=>'Hello1'}]),
 
 ok !$deep_tuple->validate([1,{a=>2},{name=>'John',age=>40}]), 'Validates ok';
 
-## Deeper Tests...
-
-my $deeper_tc = subtype
-  as Dict[
-    a => Tuple[
-        Dict[
-            a1a => Tuple[Int],
-            a1b => Tuple[Int],
-        ],
-        Dict[
-            a2a => Tuple[Int],
-            a2b => Tuple[Int],
-        ],
-    ],
-    b => Tuple[
-        Dict[
-            b1a => Tuple[Int],
-            b1b => Tuple[Int],
-        ],
-        Dict[
-            b2a => Tuple[Int],
-            b2b => Tuple[Int],
-        ],
-    ],
-  ];
-
-{
-    my $message = $deeper_tc->validate({a=>[{a1a=>[1],a1b=>[2]},{a2a=>[3],a2b=>[4]}],b=>[{b1a=>[5],b1b=>['AA']},{b2a=>[7],b2b=>[8]}]});
-    warn $message;
-}
-
-
+done_testing();