From: Jesse Luehrs Date: Mon, 25 Jul 2011 16:12:20 +0000 (-0500) Subject: be a bit stricter and more consistent with tc messages X-Git-Tag: 2.0300~132 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7e206b7455b6ec90b706c55eae34b9b0be35eb72;p=gitmo%2FMoose.git be a bit stricter and more consistent with tc messages --- diff --git a/lib/Moose/Meta/TypeConstraint.pm b/lib/Moose/Meta/TypeConstraint.pm index 6060726..f66888d 100644 --- a/lib/Moose/Meta/TypeConstraint.pm +++ b/lib/Moose/Meta/TypeConstraint.pm @@ -10,6 +10,7 @@ use overload '0+' => sub { refaddr(shift) }, # id an object bool => sub { 1 }, fallback => 1; +use Carp qw(confess); use Eval::Closure; use Scalar::Util qw(blessed refaddr); use Sub::Name qw(subname); @@ -127,6 +128,11 @@ sub new { ); } + if ( exists $args{message} + && (!ref($args{message}) || ref($args{message}) ne 'CODE') ) { + confess("The 'message' parameter must be a coderef"); + } + my $self = $class->_new(%args); $self->compile_type_constraint() unless $self->_has_compiled_type_constraint; @@ -234,7 +240,9 @@ sub assert_valid { sub get_message { my ($self, $value) = @_; - my $msg = $self->message || $self->_default_message; + my $msg = $self->has_message + ? $self->message + : $self->_default_message; local $_ = $value; return $msg->($value); }