Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

One-line, located errors, with tests. Not entirely working but with t…

…est failures.
  • Loading branch information...
commit f42935f05019497c023a0a4556864d4980fb43ec 1 parent 262251f
@ijw authored
View
25 lib/MooseX/Method/Signatures/Meta/Method.pm
@@ -1,7 +1,7 @@
package MooseX::Method::Signatures::Meta::Method;
use Moose;
-use Carp qw/cluck/;
+use Carp qw/croak cluck/;
use Context::Preserve;
use Parse::Method::Signatures;
use Parse::Method::Signatures::TypeConstraint;
@@ -130,7 +130,9 @@ sub _wrapped_body {
if (exists $args{return_signature}) {
return sub {
- my @args = ${ $self }->validate(\@_);
+ my ($err, @args) = ${ $self }->validate(\@_);
+ croak $err if $err;
+
return preserve_context { ${ $self }->actual_body->(@args) }
after => sub {
if (defined (my $msg = ${ $self }->_return_type_constraint->validate(\@_))) {
@@ -142,7 +144,10 @@ sub _wrapped_body {
my $actual_body;
return sub {
- @_ = ${ $self }->validate(\@_);
+ my $err;
+ ($err, @_) = ${ $self }->validate(\@_);
+ croak $err if $err;
+
$actual_body ||= ${ $self }->actual_body;
goto &{ $actual_body };
};
@@ -407,7 +412,8 @@ sub _build_type_constraint {
if (%named) {
my @rest = @{ $_ }[$i .. $#{ $_ }];
- confess "Expected named arguments but didn't find an even-sized list"
+ # TODO needs adjusting to throw in correct context.
+ confess $self->_err_msg("Expected named arguments but didn't find an even-sized list")
unless @rest % 2 == 0;
my %rest = @rest;
@@ -443,10 +449,17 @@ sub validate {
my $coerced;
if (defined (my $msg = $self->type_constraint->validate($args, \$coerced))) {
- confess $msg;
+ return $self->_err_msg($msg);
}
- return @{ $coerced->[0] }, map { $coerced->[1]->{$_} } @named;
+ return undef, @{ $coerced->[0] }, map { $coerced->[1]->{$_} } @named;
+}
+
+# Create the error message with locational details
+sub _err_msg {
+ my ($self, $msg)=@_;
+
+ return "Signature validation failed for " . $self->package_name . "->" . $self->name . ": ". $msg;
}
__PACKAGE__->meta->make_immutable;
View
5 t/basic.t
@@ -6,6 +6,8 @@ use Test::Exception;
use FindBin;
use lib "$FindBin::Bin/lib";
+use ErrValidate;
+
use TestClass;
use TestClassWithMxTypes;
@@ -41,7 +43,8 @@ dies_ok(sub { $o->affe('foo') });
dies_ok(sub { $o->named });
dies_ok(sub { $o->named(optional => 42) });
-throws_ok(sub { $o->named }, qr/\b at \b .* \b line \s+ \d+/x, "dies with proper exception");
+mxms_throws_ok(sub { $o->named }, 'TestClass::named',
+ qr/\b at \b .* \b line \s+ \d+/x, "dies with proper exception");
lives_ok(sub {
is_deeply(
View
36 t/lib/ErrValidate.pm
@@ -0,0 +1,36 @@
+package ErrValidate;
+
+use Test::Exception;
+
+require Exporter;
+
+our @ISA = qw(Exporter);
+
+our %EXPORT_TAGS = ( 'all' => [ qw(
+ @EXPORT
+) ] );
+
+our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
+
+our @EXPORT = qw(
+ mxms_throws_ok
+);
+
+sub mxms_throws_ok {
+ my ($sub, $testsub, $like) = @_;
+
+
+ # Details of the sub that we expect to be throwing the error
+ my ($pkg, $name) = $testsub =~ /^(.*)::(.*)$/;
+
+ # The error should consist of a proforma part describing the
+ # method that objects and the location it was called from, plus a
+ # variable part describing the type error. It should all appear
+ # on a single line; we don't guarantee anything for the passed
+ # match, but we at least make sure that there's no
+ # linefeeds in our bit.
+
+ throws_ok(sub { $sub->() },
+ qr/^Signature validation failed for $pkg->$name: [^\n]*$like[^\n]*$/m);
+
+}
View
12 t/list.t
@@ -4,6 +4,10 @@ use Test::More tests => 18;
use Test::Exception;
use MooseX::Method::Signatures;
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use ErrValidate;
+
my $o = bless {} => 'Foo';
{
@@ -43,9 +47,9 @@ my $o = bless {} => 'Foo';
is($o->${\$meth->body}('foo', 42, 23, 13), q{23,13});
});
- throws_ok(sub {
+ mxms_throws_ok(sub {
$o->${\$meth->body}('foo', 42, 'moo', 13);
- }, qr/Validation failed/);
+ }, 'main::__ANON__', qr/Validation failed/);
}
{
@@ -57,9 +61,9 @@ my $o = bless {} => 'Foo';
is($o->${\$meth->body}([42, 23], [12], [18]), '42,23,12,18');
});
- throws_ok(sub {
+ mxms_throws_ok(sub {
$o->${\$meth->body}([42, 23], 12, [18]);
- }, qr/Validation failed/);
+ }, 'main::__ANON__', qr/Validation failed/);
}
{
View
28 t/synopsis.t
@@ -3,6 +3,10 @@ use warnings;
use Test::More;
use Test::Exception;
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use ErrValidate;
+
{
package Foo;
use Moose;
@@ -49,10 +53,14 @@ isa_ok($foo, 'Foo');
lives_and(sub { is $foo->morning('Resi'), 'Good morning Resi!' }, 'positional str arg');
lives_and(sub { is $foo->hello(who => 'world', age => 42), 'Hello world, I am 42 years old!' }, 'two named args');
lives_and(sub { is $foo->greet('Resi', excited => 1), 'GREETINGS Resi!' }, 'positional and named args (with named default)');
-throws_ok(sub { $foo->hello(who => 'world', age => 'fortytwo') }, qr/Validation failed/, 'Str, Str sent to Str, Int');
-throws_ok(sub { $foo->hello(who => 'world', age => -23) }, qr/Validation failed/, 'Int violates where');
-throws_ok(sub { $foo->morning }, qr/Validation failed/, 'no required (positional) arg passed');
-throws_ok(sub { $foo->greet }, qr/Validation failed/, 'no required (positional) arg passed');
+mxms_throws_ok(sub { $foo->hello(who => 'world', age => 'fortytwo') }, 'Foo::hello',
+ qr/Validation failed/, 'Str, Str sent to Str, Int');
+mxms_throws_ok(sub { $foo->hello(who => 'world', age => -23) }, 'Foo::hello',
+ qr/Validation failed/, 'Int violates where');
+mxms_throws_ok(sub { $foo->morning }, 'Foo::morning',
+ qr/Validation failed/, 'no required (positional) arg passed');
+mxms_throws_ok(sub { $foo->greet }, 'Foo::greet',
+ qr/Validation failed/, 'no required (positional) arg passed');
my $someclass = SomeClass->new;
@@ -62,10 +70,14 @@ lives_and(sub { is $someclass->foo, 'apan:42' }, '$someclass->foo');
lives_and(sub { is $someclass->foo('quux'), 'quux:42' }, '$someclass->foo("quux")');
lives_and(sub { is $someclass->foo('quux', baz => 12), 'quux:12' }, '$someclass->foo("quux", baz => 12)');
-throws_ok(sub { $someclass->foo(baz => 12) }, qr/Expected named arguments/, '$someclass->foo(baz => 12)');
-throws_ok(sub { $someclass->foo(baz => 12, 'quux') }, qr/Validation failed/, '$someclass->foo(baz => 12, "quux")');
-throws_ok(sub { $someclass->foo(baz => 41) }, qr/Expected named arguments/, '$someclass->foo(baz => 41)');
-throws_ok(sub { $someclass->foo(baz => 44) }, qr/Expected named arguments/, '$someclass->foo(baz => 12)');
+mxms_throws_ok(sub { $someclass->foo(baz => 12) }, 'SomeClass::foo',
+ qr/Expected named arguments/, '$someclass->foo(baz => 12)');
+mxms_throws_ok(sub { $someclass->foo(baz => 12, 'quux') }, 'SomeClass::foo',
+ qr/Validation failed/, '$someclass->foo(baz => 12, "quux")');
+mxms_throws_ok(sub { $someclass->foo(baz => 41) }, 'SomeClass::foo',
+ qr/Expected named arguments/, '$someclass->foo(baz => 41)');
+mxms_throws_ok(sub { $someclass->foo(baz => 44) }, 'SomeClass::foo',
+ qr/Expected named arguments/, '$someclass->foo(baz => 12)');
done_testing;
View
7 t/too_many_args.t
@@ -3,6 +3,10 @@ use warnings;
use Test::More;
use Test::Exception;
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use ErrValidate;
+
{
package Foo;
use Moose;
@@ -13,6 +17,7 @@ use Test::Exception;
my $o = Foo->new;
lives_ok(sub { $o->foo(42) });
-throws_ok(sub { $o->foo(42, 23) }, qr/Validation failed/);
+mxms_throws_ok(sub { $o->foo(42, 23) }, 'Foo::foo',
+ qr/Validation failed/);
done_testing;
View
32 t/where.t
@@ -3,6 +3,10 @@ use warnings;
use Test::More;
use Test::Exception;
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use ErrValidate;
+
{
package Foo::Bar;
use Moose;
@@ -31,27 +35,41 @@ my $foo = Foo->new;
isa_ok($foo, 'Foo');
lives_and(sub { is $foo->m1('foo'), 'foo' }, 'where positional string type');
-throws_ok(sub { $foo->m1('bar') }, qr/Validation failed/, 'where positional string type');
+mxms_throws_ok(sub { $foo->m1('bar') },
+ 'Foo::m1',
+ qr/Validation failed/, 'where positional string type');
lives_and(sub { is $foo->m2(1), 1 }, 'where positional int type');
-throws_ok(sub { $foo->m2(0) }, qr/Validation failed/, 'where positional int type');
+mxms_throws_ok(sub { $foo->m2(0) },
+ 'Foo::m2',
+ qr/Validation failed/, 'where positional int type');
lives_and(sub { is $foo->m3(Foo::Bar->new), 'quux' }, 'where positional class type');
-throws_ok(sub { $foo->m3(Foo::Bar->new({ baz => 'affe' })) }, qr/Validation failed/, 'where positional class type');
+mxms_throws_ok(sub { $foo->m3(Foo::Bar->new({ baz => 'affe' })) },
+ 'Foo::m3',
+ qr/Validation failed/, 'where positional class type');
lives_and(sub { is $foo->m4(arg => 'foo'), 'foo' }, 'where named string type');
-throws_ok(sub { $foo->m4(arg => 'bar') }, qr/Validation failed/, 'where named string type');
+mxms_throws_ok(sub { $foo->m4(arg => 'bar') },
+ 'Foo::m4',
+ qr/Validation failed/, 'where named string type');
lives_and(sub { is $foo->m5(arg => 1), 1 }, 'where named int type');
-throws_ok(sub { $foo->m5(arg => 0) }, qr/Validation failed/, 'where named int type');
+mxms_throws_ok(sub { $foo->m5(arg => 0) },
+ 'Foo::m5',
+ qr/Validation failed/, 'where named int type');
lives_and(sub { is $foo->m6(arg => Foo::Bar->new), 'quux' }, 'where named class type');
-throws_ok(sub { $foo->m6(arg => Foo::Bar->new({ baz => 'affe' })) }, qr/Validation failed/, 'where named class type');
+mxms_throws_ok(sub { $foo->m6(arg => Foo::Bar->new({ baz => 'affe' })) },
+ 'Foo::m6',
+ qr/Validation failed/, 'where named class type');
lives_ok(sub { $foo->m7(1) }, 'where positional');
lives_ok(sub { $foo->m8(arg => 1) }, 'where named');
lives_and(sub { is $foo->m9('bar'), 'bar' }, 'where positional string type with default');
-throws_ok(sub { $foo->m9 }, qr/Validation failed/, 'where positional string type with default');
+mxms_throws_ok(sub { $foo->m9 },
+ 'Foo::m9',
+ qr/Validation failed/, 'where positional string type with default');
done_testing;
Please sign in to comment.
Something went wrong with that request. Please try again.