From: John Napiorkowski <jjnapiork@cpan.org>
Date: Fri, 6 Mar 2009 17:02:42 +0000 (+0000)
Subject: added some code to improve the error message and added test for that
X-Git-Tag: 0.09~4
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMooseX-Types-Structured.git;a=commitdiff_plain;h=797510e368ab5ee7fbc25581fa484534aa0988d3

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
--- 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
--- 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
--- 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
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';
+