X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FTypes%2FStructured.pm;h=808985f08eccf6fdfcced0dde3fbd6fa6e4234df;hb=bd69ead0711f42bcb24d22f70ebe70baad3bcb39;hp=31448c61e76ae2a8322620a5f3a78002f2b40e12;hpb=803669ea2ac2724e6ea467f842deacbd384a5286;p=gitmo%2FMooseX-Types-Structured.git

diff --git a/lib/MooseX/Types/Structured.pm b/lib/MooseX/Types/Structured.pm
index 31448c6..808985f 100644
--- a/lib/MooseX/Types/Structured.pm
+++ b/lib/MooseX/Types/Structured.pm
@@ -6,6 +6,7 @@ use Moose::Util::TypeConstraints;
 use MooseX::Meta::TypeConstraint::Structured;
 use MooseX::Meta::TypeConstraint::Structured::Optional;
 use MooseX::Types::Structured::OverflowHandler;
+use MooseX::Types::Structured::TypeError;
 use MooseX::Types -declare => [qw(Dict Map Tuple Optional)];
 use Sub::Exporter -setup => [ qw(Dict Map Tuple Optional slurpy) ];
 use Devel::PartialDump;
@@ -745,23 +746,32 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
 
 			my @values = defined $values ? @$values: ();
 			## Perform the checking
+			my $slot = 0;
 			while(@type_constraints) {
 				my $type_constraint = shift @type_constraints;
 				if(@values) {
 					my $value = shift @values;
 					unless($type_constraint->check($value)) {
-                        $_[2]->{message} = $type_constraint->get_message($value)
+                        $_[2]->{message} = MooseX::Types::Structured::TypeError->new(
+				constraint => $type_constraint,
+				value => $value,
+				index => $slot,
+			       )
                          if ref $_[2];
 						return;
 					}
 				} else {
                     ## Test if the TC supports null values
                     unless ($type_constraint->is_subtype_of($Optional)) {
-                        $_[2]->{message} = $type_constraint->get_message('NULL')
+                        $_[2]->{message} = MooseX::Types::Structured::TypeError->new(
+				constraint => $type_constraint,
+				index => $slot,
+			       )
                          if ref $_[2];
 						return;
 					}
 				}
+				++$slot;
 			}
 			## Make sure there are no leftovers.
 			if(@values) {
@@ -809,14 +819,21 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
 					my $value = $values{$key};
 					delete $values{$key};
 					unless($type_constraint->check($value)) {
-                        $_[2]->{message} = $type_constraint->get_message($value)
+                         $_[2]->{message} = MooseX::Types::Structured::TypeError->new(
+				constraint => $type_constraint,
+				index => $key,
+				value => $value,
+			       )
                          if ref $_[2];
 						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')
+                         $_[2]->{message} = MooseX::Types::Structured::TypeError->new(
+				constraint => $type_constraint,
+				index => $key,
+			       )
                          if ref $_[2];
 						return;
 					}