[Moose-commits] r7880 - in MooseX-Types-Dependent/trunk: .
lib/MooseX/Meta/TypeConstraint t
jnapiorkowski at code2.0beta.co.uk
jnapiorkowski at code2.0beta.co.uk
Wed Apr 1 17:14:03 BST 2009
Author: jnapiorkowski
Date: 2009-04-01 09:14:03 -0700 (Wed, 01 Apr 2009)
New Revision: 7880
Added:
MooseX-Types-Dependent/trunk/t/03-api.t
Modified:
MooseX-Types-Dependent/trunk/Makefile.PL
MooseX-Types-Dependent/trunk/lib/MooseX/Meta/TypeConstraint/Dependent.pm
MooseX-Types-Dependent/trunk/t/02-depending.t
Log:
placeholder for api test, much improved support for error message (now give you more details about what type of failure you have (should backport to MX:T:Structured...)
updates to docs and updates to the makefile
Modified: MooseX-Types-Dependent/trunk/Makefile.PL
===================================================================
--- MooseX-Types-Dependent/trunk/Makefile.PL 2009-04-01 03:11:50 UTC (rev 7879)
+++ MooseX-Types-Dependent/trunk/Makefile.PL 2009-04-01 16:14:03 UTC (rev 7880)
@@ -11,6 +11,7 @@
requires 'Moose' => '0.73';
requires 'MooseX::Types' => '0.10';
requires 'Scalar::Util' => '1.19';
+requires 'Devel::PartialDump' => '0.07';
## Testing dependencies
build_requires 'Test::More' => '0.70';
Modified: MooseX-Types-Dependent/trunk/lib/MooseX/Meta/TypeConstraint/Dependent.pm
===================================================================
--- MooseX-Types-Dependent/trunk/lib/MooseX/Meta/TypeConstraint/Dependent.pm 2009-04-01 03:11:50 UTC (rev 7879)
+++ MooseX-Types-Dependent/trunk/lib/MooseX/Meta/TypeConstraint/Dependent.pm 2009-04-01 16:14:03 UTC (rev 7880)
@@ -4,6 +4,7 @@
use Moose;
use Moose::Util::TypeConstraints ();
use MooseX::Meta::TypeCoercion::Dependent;
+use Devel::PartialDump;
extends 'Moose::Meta::TypeConstraint';
=head1 NAME
@@ -49,7 +50,8 @@
isa=>'Object',
predicate=>'has_constraining_type_constraint',
handles=>{
- check_constraining=>'check',
+ check_constraining=>'check',
+ get_message_constraining=>'get_message',
},
);
@@ -112,27 +114,22 @@
We intercept validate in order to custom process the message
-
=cut
-around 'check' => sub {
- my ($check, $self, @args) = @_;
- my ($result, $message) = $self->_compiled_type_constraint->(@args);
- warn $result;
- return $result;
-};
-
around 'validate' => sub {
my ($validate, $self, @args) = @_;
- my ($result, $message) = $self->_compiled_type_constraint->(@args);
-
+ my $compiled_type_constraint = $self->_compiled_type_constraint;
+ my $message = bless {message=>undef}, 'MooseX::Types::Dependent::Message';
+ my $result = $compiled_type_constraint->(@args, $message);
+
if($result) {
return $result;
} else {
- if(defined $message) {
- return "Inner: $message";
- } else { warn '......................';
- return $self->get_message(@args);
+ my $args = Devel::PartialDump::dump(@args);
+ if(my $message = $message->{message}) {
+ return $self->get_message("$args, Internal Validation Error is: $message");
+ } else {
+ return $self->get_message($args);
}
}
};
@@ -152,10 +149,14 @@
## First need to test the bits
unless($self->check_dependent($dependent)) {
- return (undef, 'bbbbbb');
+ $_[0]->{message} = $self->get_message_dependent($dependent)
+ if $_[0];
+ return;
}
unless($self->check_constraining($constraining)) {
+ $_[0]->{message} = $self->get_message_constraining($constraining)
+ if $_[0];
return;
}
@@ -209,7 +210,10 @@
This returns a CODEREF which generates a suitable constraint generator. Not
user servicable, you'll never call this directly.
- TBD, this is definitely going to need some work.
+ TBD, this is definitely going to need some work. Cargo culted from some
+ code I saw in Moose::Meta::TypeConstraint::Parameterized or similar. I
+ Don't think I need this, since Dependent types require parameters, so
+ will always have a constrain generator.
=cut
@@ -218,7 +222,7 @@
if($self->has_constraint_generator) {
return $self->constraint_generator;
} else {
- warn "I'm doing the questioning infer generator thing";
+ warn "I'm doing the questionable infer generator thing";
return sub {
## I'm not sure about this stuff but everything seems to work
my $tc = shift @_;
@@ -247,7 +251,7 @@
my $generated_constraint = $self->generate_constraint_for(
$self->comparison_callback,
);
- $self->_set_constraint($generated_constraint);
+ $self->_set_constraint($generated_constraint);
}
return $self->$compile_type_constraint;
@@ -322,17 +326,13 @@
=head2 get_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
+Give you a better peek into what's causing the error.
- TBD
+=cut
around 'get_message' => sub {
my ($get_message, $self, $value) = @_;
- my $new_value = Devel::PartialDump::dump($value);
- return $self->$get_message($new_value);
+ return $self->$get_message($value);
};
=head1 SEE ALSO
Modified: MooseX-Types-Dependent/trunk/t/02-depending.t
===================================================================
--- MooseX-Types-Dependent/trunk/t/02-depending.t 2009-04-01 03:11:50 UTC (rev 7879)
+++ MooseX-Types-Dependent/trunk/t/02-depending.t 2009-04-01 16:14:03 UTC (rev 7880)
@@ -1,9 +1,8 @@
-use Test::More tests=>24; {
+use Test::More tests=>29; {
use strict;
use warnings;
-
- use Test::Exception;
+
use MooseX::Types::Dependent qw(Depending);
use MooseX::Types::Moose qw(Int Str Object ArrayRef HashRef Maybe);
use MooseX::Types -declare => [qw(
@@ -57,7 +56,8 @@
my ($dependent_val, $constraining_value) = @$_;
return $dependent_val > 2 ? 1:undef;
};
-
+ #message {"Custom Error: $_"};
+
isa_ok UniqueInt, 'MooseX::Meta::TypeConstraint::Dependent';
ok !UniqueInt->check(['a',[1,2,3]]), '"a" not an Int';
ok !UniqueInt->check([1,['b','c']]), '"b","c" not an arrayref';
@@ -88,6 +88,18 @@
ok UniqueInt2->check([4,[100..110]]), 'PASS unique in set';
## Basic error messages. TODO should be it's own test
+ like UniqueInt->validate(['a',[1,2,3]]), qr/failed for 'Int' failed with value a/,
+ "a is not an Int";
- warn UniqueInt2->validate(['a',[1,2,3]]);
+ like UniqueInt->validate([1,['b','c']]), qr/failed for 'ArrayRef\[Int\]'/,
+ "ArrayRef doesn't contain Ints";
+
+ like UniqueInt->validate([1,[1,2,3]]), qr/failed with value \[ 1, \[ 1, 2, 3 \] \]/,
+ "Is not unique in the constraint";
+
+ like UniqueInt->validate([10,[1,10,15]]), qr/failed with value \[ 10, \[ 1, 10, 15 \] \]/,
+ "Expected Error message for [10,[1,10,15]]";
+
+ like UniqueInt->validate([2,[3..6]]), qr/failed with value \[ 2, \[ 3, 4, 5, 6 \] \]/,
+ "Expected Error message for [2,[3..6]]";
}
Added: MooseX-Types-Dependent/trunk/t/03-api.t
===================================================================
--- MooseX-Types-Dependent/trunk/t/03-api.t (rev 0)
+++ MooseX-Types-Dependent/trunk/t/03-api.t 2009-04-01 16:14:03 UTC (rev 7880)
@@ -0,0 +1,32 @@
+use Test::More tests=>1; {
+
+ use strict;
+ use warnings;
+
+ use Test::Exception;
+ use MooseX::Types::Dependent qw(Depending);
+ use MooseX::Types::Moose qw(Int ArrayRef );
+ use MooseX::Types -declare => [qw(
+ UniqueInt
+ )];
+
+ ## sugar for alternative syntax: depending {} TC,TC
+ sub depending(&@) {
+ my ($coderef, $dependent_tc, $constraining_tc, @args) = @_;
+ if(@args) {
+ return (Depending[$dependent_tc,$coderef,$constraining_tc], at args);
+ } else {
+ return Depending[$dependent_tc,$coderef,$constraining_tc];
+ }
+ }
+
+ ok subtype UniqueInt,
+ as depending {
+ my ($dependent_int, $constraining_arrayref) = @_;
+ (grep { $_ == $dependent_int} @$constraining_arrayref) ? undef:1
+ } Int, ArrayRef[Int],
+ where {
+ my ($dependent_val, $constraining_value) = @$_;
+ return $dependent_val > 2 ? 1:undef;
+ };
+}
More information about the Moose-commits
mailing list