added some code to improve the error message and added test for that

diff --git a/Makefile.PL b/Makefile.PL
index 93ba307..f74e9dd 100644 (file)
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -10,6 +10,7 @@ license 'perl';
 ## Module dependencies
 requires 'Moose' => '0.63';
 requires 'MooseX::Types' => '0.08';
+requires 'Devel::PartialDump' => '0.07';
 
 ## Testing dependencies
 build_requires 'Test::More' => '0.70';

diff --git a/lib/MooseX/Meta/TypeConstraint/Structured.pm b/lib/MooseX/Meta/TypeConstraint/Structured.pm
index a5da66e..34ab8e1 100644 (file)
--- a/lib/MooseX/Meta/TypeConstraint/Structured.pm
+++ b/lib/MooseX/Meta/TypeConstraint/Structured.pm
@@ -2,6 +2,7 @@ package ## Hide from PAUSE
  MooseX::Meta::TypeConstraint::Structured;
 
 use Moose;
+use Devel::PartialDump;
 use Moose::Util::TypeConstraints ();
 use MooseX::Meta::TypeCoercion::Structured;
 extends 'Moose::Meta::TypeConstraint';
@@ -215,7 +216,19 @@ sub type_constraints_equals {
 
 =head2 get_message
 
-May want to override this to set a more useful error message
+Give you a better peek into what's causing the error.  For now we stringify the
+incoming deep value with L<Devel::PartialDump> and pass that on to either your
+custom error message or the default one.  In the future we'll try to provide a
+more complete stack trace of the actual offending elements
+
+=cut
+
+around 'get_message' => sub {
+    my ($get_message, $self, $value) = @_;
+    my $new_value = Devel::PartialDump::dump($value);
+    return $self->$get_message($new_value);
+    
+};
 
 =head1 SEE ALSO
 

diff --git a/t/11-overflow.t b/t/11-overflow.t
index a57f327..3e8d0f4 100644 (file)
--- a/t/11-overflow.t
+++ b/t/11-overflow.t
@@ -72,4 +72,3 @@ ok $array_tailed_dict->check({name=>'Vanessa Li', age=>35}), 'correct pass';
 ok !$array_tailed_dict->check([]), 'correct fail';
 ok $array_tailed_dict->check({name=>'Vanessa Li', age=>35, 1,2}), 'correct pass with tail';
 ok !$array_tailed_dict->check({name=>'Vanessa Li', age=>35, 1, "hello"}), 'correct fail with tail';
-

diff --git a/t/12-error.t b/t/12-error.t
new file mode 100644 (file)
index 0000000..e480c2a
--- /dev/null
+++ b/t/12-error.t
@@ -0,0 +1,20 @@
+BEGIN {
+       use strict;
+       use warnings;
+       use Test::More tests=>4;
+}
+
+use Moose::Util::TypeConstraints;
+use MooseX::Types::Structured qw(Dict Tuple);
+use MooseX::Types::Moose qw(Int Str ArrayRef HashRef);
+
+# Create some TCs from which errors will be generated
+my $simple_tuple = subtype 'simple_tuple', as Tuple[Int,Str];
+my $simple_dict = subtype 'simple_dict', as Dict[name=>Str,age=>Int];
+
+# We probably need more stuff here...
+ok $simple_tuple->check([1,'hello']), "simple_tuple validates: 1,'hello'";
+ok !$simple_tuple->check(['hello',1]), "simple_tuple fails: 'hello',1";
+like $simple_tuple->validate(['hello',1]), qr/"hello", 1/, 'got expected valiate message';
+like $simple_dict->validate(['hello',1]), qr/"hello", 1/, 'got expected valiate message';
+