From: James Laver <jjl@baozi.config>
Date: Thu, 29 Jul 2010 17:44:37 +0000 (+0100)
Subject: Updated to take advantage of new Devel::StackTrace
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=refs%2Fheads%2Ftopic%2Fexception-object;p=gitmo%2FClass-MOP.git

Updated to take advantage of new Devel::StackTrace
---

diff --git a/lib/Class/MOP/Exception.pm b/lib/Class/MOP/Exception.pm
index 0110155..81d2ebb 100644
--- a/lib/Class/MOP/Exception.pm
+++ b/lib/Class/MOP/Exception.pm
@@ -15,26 +15,17 @@ sub stacktrace { shift->{stacktrace}; }
 
 # Builder for stacktrace
 sub _build_stacktrace {
-    shift->{stacktrace} = Devel::StackTrace->new(ignore_class => __PACKAGE__);
+    my ($self) = @_;
+    $self->{stacktrace} = Devel::StackTrace->new(
+        ignore_class => __PACKAGE__,
+        indent => 1,
+        message => $self->message,
+    );
 }
 
 # Stringification
 sub to_string {
-    my ($self) = @_;
-    my $first = 1;
-    my @lines;
-    while (my $frame = $self->{stacktrace}->next_frame) {
-        if ($first) {
-            $first = 0;
-            # message at foo.pl line 1
-            push @lines, sprintf("%s at %s line %s", $self->message, $frame->filename, $frame->line);
-        } else {
-            my @args = map { ref $_ ? "$_" : "'$_'" } $frame->args;
-            # main::foo called at foo.pl line 1
-            push @lines, sprintf("\t%s(%s) called at %s line %s", $frame->subroutine, join(", ", @args), $frame->filename, $frame->line);
-        }
-    }
-    join("\n", @lines);
+    shift->stacktrace->as_string
 }
 
 # Constructor
diff --git a/t/316_exceptions.t b/t/316_exceptions.t
index 3449f8a..db71e05 100644
--- a/t/316_exceptions.t
+++ b/t/316_exceptions.t
@@ -47,48 +47,12 @@ use Test::More;
     my $b2 = Bar::one();
     my $b3 = Bar::one(foo => {1,2});
 
-################################################## BASIC TESTS ###################
-
     isa_ok($_,'Class::MOP::Exception',"type check") for ($f1,$f2,$f3,$b1,$b2,$b3);
     isa_ok($_->stacktrace, 'Devel::StackTrace',"stacktraces are stacktraces") for ($f1,$f2,$f3,$b1,$b2,$b3);
     ok(!ref $_->message,"messages are strings") for ($f1,$f2,$f3,$b1,$b2,$b3);
     is($_->message,'bar', "correct messages") for ($f1,$b1);
     ok(!$_->message,'lack of messages') for ($f2,$f3,$b2,$b3);
     
-################################################## STRINGIFICATION TESTS ###################
-    
-    # Verify number of frames dumped
-    is(scalar @{[split(/\n/,$_)]}, 2, "length of foos") for $f1,$f2,$f3;
-    is(scalar @{[split(/\n/,$_)]}, 4, "length of bars") for $b1,$b2,$b3;
-    
-    # Verify initial lines
-    like([split(/\n/,$_)]->[0], qr{ at t/[0-9]+_[a-zA-Z0-9_-]+\.t line [0-9]+$},"error messages contain correct info") for ($f1,$f2,$f3,$b1,$b2,$b3);
-
-    # And the messages of the initial lines
-    like([split(/\n/,$_)]->[0], qr{^bar at t/}, "messages of f1,b1") for ($f1,$b1);
-    
-    # And the lack of messages of the other lines
-    like([split(/\n/,$_)]->[0], qr{^ at t/}, "messages of others") for ($f2,$f3,$b2,$b3);
-
-    # And the second lines of foo
-    like([split(/\n/,$f1)]->[1], qr{^\tFoo::except\(Foo=HASH\(0x[0-9a-f]+\), 'message', 'bar'\) called at t/[0-9]+_[a-zA-Z0-9_-]+\.t line [0-9]+$},"f1[1]");
-    like([split(/\n/,$f2)]->[1], qr{^\tFoo::except\(Foo=HASH\(0x[0-9a-f]+\)\) called at t/[0-9]+_[a-zA-Z0-9_-]+\.t line [0-9]+$},"f2[1]");
-    like([split(/\n/,$f3)]->[1], qr{^\tFoo::except\(Foo=HASH\(0x[0-9a-f]+\), 'foo', HASH\(0x[0-9a-f]+\)\) called at t/[0-9]+_[a-zA-Z0-9_-]+\.t line [0-9]+$},"f3[1]");
-
-    # And the second lines of bar
-    like([split(/\n/,$b1)]->[1], qr{^\tBar::three\('message', 'bar'\) called at t/[0-9]+_[a-zA-Z0-9_-]+\.t line [0-9]+$},"b1[1]");
-    like([split(/\n/,$b2)]->[1], qr{^\tBar::three\(\) called at t/[0-9]+_[a-zA-Z0-9_-]+\.t line [0-9]+$},"b2[1]");
-    like([split(/\n/,$b3)]->[1], qr{^\tBar::three\('foo', HASH\(0x[0-9a-f]+\)\) called at t/[0-9]+_[a-zA-Z0-9_-]+\.t line [0-9]+$},"b3[1]");
-
-    # And the third lines of bar
-    like([split(/\n/,$b1)]->[2], qr{^\tBar::two\('message', 'bar'\) called at t/[0-9]+_[a-zA-Z0-9_-]+\.t line [0-9]+$},"b1[2]");
-    like([split(/\n/,$b2)]->[2], qr{^\tBar::two\(\) called at t/[0-9]+_[a-zA-Z0-9_-]+\.t line [0-9]+$},"b2[2]");
-    like([split(/\n/,$b3)]->[2], qr{^\tBar::two\('foo', HASH\(0x[0-9a-f]+\)\) called at t/[0-9]+_[a-zA-Z0-9_-]+\.t line [0-9]+$},"b3[2]");
-
-    # And the fourth lines of bar
-    like([split(/\n/,$b1)]->[3], qr{^\tBar::one\('message', 'bar'\) called at t/[0-9]+_[a-zA-Z0-9_-]+\.t line [0-9]+$},"b1[3]");
-    like([split(/\n/,$b2)]->[3], qr{^\tBar::one\(\) called at t/[0-9]+_[a-zA-Z0-9_-]+\.t line [0-9]+$},"b2[3]");
-    like([split(/\n/,$b3)]->[3], qr{^\tBar::one\('foo', HASH\(0x[0-9a-f]+\)\) called at t/[0-9]+_[a-zA-Z0-9_-]+\.t line [0-9]+$},"b3[3]");
 }
 
 done_testing;