From: Shawn M Moore <code@sartak.org>
Date: Thu, 14 Jun 2012 20:58:23 +0000 (-0500)
Subject: TypeConstraint errors
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=dfd0247bf53d36c857a1a4fc56f1e00eedd971eb;p=gitmo%2FMoose.git

TypeConstraint errors
---

diff --git a/lib/Moose/Exception/TypeConstraint.pm b/lib/Moose/Exception/TypeConstraint.pm
new file mode 100644
index 0000000..9dd75a5
--- /dev/null
+++ b/lib/Moose/Exception/TypeConstraint.pm
@@ -0,0 +1,27 @@
+package Moose::Exception::TypeConstraint;
+use Moose;
+extends 'Throwable::Error';
+
+has attribute_name => (
+    is  => 'ro',
+    isa => 'Str',
+);
+
+has type_name => (
+    is       => 'ro',
+    isa      => 'Str',
+    required => 1,
+);
+
+has value => (
+    is       => 'ro',
+    required => 1,
+);
+
+has instance => (
+    is  => 'ro',
+    isa => 'Object',
+);
+
+1;
+
diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm
index 4391475..6fbe47f 100644
--- a/lib/Moose/Meta/Attribute.pm
+++ b/lib/Moose/Meta/Attribute.pm
@@ -695,7 +695,10 @@ sub _inline_check_constraint {
                   . 'do { local $_ = ' . $value . '; '
                       . $message . '->(' . $value . ')'
                   . '}',
-                    'data => ' . $value
+                    'roles => ["Moose::Exception::TypeConstraint"]',
+                    'attribute_name => ' . $self->name,
+                    'type_name => ' . $self->type_constraint->name,
+                    'value => ' . $value,
                 ) . ';',
             '}',
         );
@@ -709,7 +712,10 @@ sub _inline_check_constraint {
                   . 'do { local $_ = ' . $value . '; '
                       . $message . '->(' . $value . ')'
                   . '}',
-                    'data => ' . $value
+                    'roles => ["Moose::Exception::TypeConstraint"]',
+                    'attribute_name => ' . $self->name,
+                    'type_name => ' . $self->type_constraint->name,
+                    'value => ' . $value,
                 ) . ';',
             '}',
         );
@@ -1255,10 +1261,16 @@ sub verify_against_type_constraint {
     my $type_constraint = $self->type_constraint;
 
     $type_constraint->check($val)
-        || $self->throw_error("Attribute ("
+        || $self->throw_error(
+                superclass => 'Moose::Exception::TypeConstraint',
+                message => "Attribute ("
                  . $self->name
                  . ") does not pass the type constraint because: "
-                 . $type_constraint->get_message($val), data => $val, @_);
+                 . $type_constraint->get_message($val),
+                 value => $val,
+                 attribute_name => $self->name,
+                 type_name => $type_constraint->name,
+                 @_);
 }
 
 package Moose::Meta::Attribute::Custom::Moose;