error tests and fixes

diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm
index 09c6ce1..564adbd 100644 (file)
--- a/lib/Moose/Meta/Attribute.pm
+++ b/lib/Moose/Meta/Attribute.pm
@@ -70,7 +70,8 @@ sub throw_error {
     unshift @_, "message" if @_ % 2 == 1;
     unshift @_, attr => $self if ref $self;
     unshift @_, $class;
-    goto $class->can("throw_error"); # to avoid incrementing depth by 1
+    my $handler = $class->can("throw_error"); # to avoid incrementing depth by 1
+    goto $handler;
 }
 
 sub new {

diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm
index ed252a8..55e6d50 100644 (file)
--- a/lib/Moose/Meta/Class.pm
+++ b/lib/Moose/Meta/Class.pm
@@ -674,13 +674,16 @@ sub raise_error {
 sub create_error {
     my ( $self, @args ) = @_;
 
+    require Carp::Heavy;
+
+    local $level = $level + 1;
+
+
     if ( @args % 2 == 1 ) {
         unshift @args, "message";
     }
 
-    my %args = ( meta => $self, error => $@, @args );
-
-    local $level = $level + 1;
+    my %args = ( Carp::caller_info($level), metaclass => $self, error => $@, @args );
 
     if ( my $class = $args{class} || ( ref $self && $self->error_class ) ) {
         return $self->create_error_object( %args, class => $class );
@@ -720,16 +723,15 @@ sub _create_error_carpmess {
     my ( $self, %args ) = @_;
 
     my $carp_level = $level + 1 + ( $args{depth} || 1 );
-
-    local $Carp::CarpLevel = $carp_level; # $Carp::CarpLevel + $carp_level ?
     local $Carp::MaxArgNums = 20;         # default is 8, usually we use named args which gets messier though
 
     my @args = exists $args{message} ? $args{message} : ();
 
-    if ( $args{longmess} ) {
+    if ( $args{longmess} || $Carp::Verbose ) {
+        local $Carp::CarpLevel = ( $Carp::CarpLevel || 0 ) + $carp_level;
         return Carp::longmess(@args);
     } else {
-        return Carp::shortmess(@args);
+        return Carp::ret_summary($carp_level, @args);
     }
 }
 

diff --git a/lib/Moose/Meta/Method.pm b/lib/Moose/Meta/Method.pm
index a01751a..ee34d32 100644 (file)
--- a/lib/Moose/Meta/Method.pm
+++ b/lib/Moose/Meta/Method.pm
@@ -11,8 +11,7 @@ use base 'Class::MOP::Method';
 
 sub _error_thrower {
     my $self = shift;
-    return "Moose::Meta::Class";
-    #( $self->associated_attribute || $self->associated_class ) # FIXME move to Accessor, fix for Constructor
+    ( ref $self && $self->associated_metaclass ) || "Moose::Meta::Class";
 }
 
 sub throw_error {

diff --git a/lib/Moose/Meta/Method/Accessor.pm b/lib/Moose/Meta/Method/Accessor.pm
index 65835a0..0208643 100644 (file)
--- a/lib/Moose/Meta/Method/Accessor.pm
+++ b/lib/Moose/Meta/Method/Accessor.pm
@@ -11,7 +11,10 @@ our $AUTHORITY = 'cpan:STEVAN';
 use base 'Moose::Meta::Method',
          'Class::MOP::Method::Accessor';
 
-## Inline method generators
+sub _error_thrower {
+    my $self = shift;
+    ( ref $self && $self->associated_attribute ) || $self->SUPER::_error_thrower();
+}
 
 sub _eval_code {
     my ( $self, $code ) = @_;