From c206a611a17fa3e303a877d4a9a7c7f8531072fc Mon Sep 17 00:00:00 2001 From: Arthur Axel 'fREW' Schmidt Date: Sat, 21 Jul 2012 14:52:45 -0500 Subject: [PATCH 01/11] update dist.ini --- dist.ini | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/dist.ini b/dist.ini index 2c2af08..fe07476 100644 --- a/dist.ini +++ b/dist.ini @@ -6,6 +6,6 @@ copyright_holder = Ricardo SIGNES [@RJBS] -[Prereq] +[Prereqs] Devel::StackTrace = 1.21 ; frame_filter From 3658b773f84bb9756a727d4c8198dab24810253b Mon Sep 17 00:00:00 2001 From: Arthur Axel 'fREW' Schmidt Date: Sat, 21 Jul 2012 15:22:37 -0500 Subject: [PATCH 02/11] test single arg style --- t/basic.t | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/t/basic.t b/t/basic.t index dd7513a..2150813 100644 --- a/t/basic.t +++ b/t/basic.t @@ -1,7 +1,7 @@ #!perl use strict; use warnings; -use Test::More tests => 9; +use Test::More tests => 11; { package MyError; @@ -36,3 +36,11 @@ is($frames[0]->subroutine, q{Throwable::throw}, 'correct frame 0'); is($frames[1]->subroutine, q{main::throw_x}, 'correct frame 1'); is($frames[2]->subroutine, q{main::call_throw_x}, 'correct frame 2'); is($frames[3]->subroutine, q{(eval)}, 'correct frame 3'); + +{ + eval { MyError->throw('shucks howdy'); }; + + my $error = $@; + isa_ok($error, 'MyError', 'the error'); + is($error->message, q{shucks howdy}, "error message is correct"); +} From 2d368114e82a548ac30af4cedc213acf4add49e0 Mon Sep 17 00:00:00 2001 From: Matt S Trout Date: Sat, 21 Jul 2012 21:14:06 +0000 Subject: [PATCH 03/11] stack trace without stack marker --- lib/StackTrace/Auto.pm | 30 +++++++++++------------------- t/basic.t | 2 ++ 2 files changed, 13 insertions(+), 19 deletions(-) diff --git a/lib/StackTrace/Auto.pm b/lib/StackTrace/Auto.pm index 2749604..656182a 100644 --- a/lib/StackTrace/Auto.pm +++ b/lib/StackTrace/Auto.pm @@ -78,18 +78,22 @@ sub _build_stack_trace_class { sub _build_stack_trace_args { my ($self) = @_; my $found_mark = 0; - my $uplevel = 3; # number of *raw* frames to go up after we found the marker return [ frame_filter => sub { my ($raw) = @_; - if ($found_mark) { - return 1 unless $uplevel; - return !$uplevel--; + if ($found_mark == 2) { + return 1; } - else { - $found_mark = scalar $raw->{caller}->[3] =~ /__stack_marker$/; + elsif ($found_mark == 1) { + if ($raw->{caller}->[3] =~ /::new$/) { + $found_mark = 2; + return 0; + } return 0; - } + } else { + $found_mark++ if $raw->{caller}->[3] =~ /::_build_stack_trace$/; + return 0; + } }, ]; } @@ -101,17 +105,5 @@ sub _build_stack_trace { ); } -around new => sub { - my $next = shift; - my $self = shift; - return $self->__stack_marker($next, @_); -}; - -sub __stack_marker { - my $self = shift; - my $next = shift; - return $self->$next(@_); -} - no Moose::Role; 1; diff --git a/t/basic.t b/t/basic.t index 2150813..03fddb4 100644 --- a/t/basic.t +++ b/t/basic.t @@ -18,6 +18,8 @@ sub call_throw_x { throw_x; } +warn MyError->new({ message => 'm' }); + eval { call_throw_x; }; my $error = $@; From 34d49f9f9299987144b0a3142cafe815751a3973 Mon Sep 17 00:00:00 2001 From: Arthur Axel 'fREW' Schmidt Date: Sat, 21 Jul 2012 03:28:17 -0500 Subject: [PATCH 04/11] Port to Moo --- Changes | 1 + lib/StackTrace/Auto.pm | 53 ++++++++++++++++++++++-------------------- lib/Throwable.pm | 23 +++++++++++------- lib/Throwable/Error.pm | 7 +++--- t/basic.t | 3 +-- 5 files changed, 48 insertions(+), 39 deletions(-) diff --git a/Changes b/Changes index ea2e207..06999bc 100644 --- a/Changes +++ b/Changes @@ -1,6 +1,7 @@ Revision history for Throwable {{$NEXT}} + port to Moo 0.102080 2010-07-27 12:09:21 America/New_York refactor stack trace autocreation to StackTrace::Auto role diff --git a/lib/StackTrace/Auto.pm b/lib/StackTrace/Auto.pm index 656182a..60277bb 100644 --- a/lib/StackTrace/Auto.pm +++ b/lib/StackTrace/Auto.pm @@ -1,5 +1,9 @@ package StackTrace::Auto; -use Moose::Role 0.87; +use Moo::Role; +use Sub::Quote (); +use MooX::Types::MooseLike::Base qw(Str ArrayRef); +use Module::Runtime 'require_module'; + # ABSTRACT: a role for generating stack traces during instantiation =head1 SYNOPSIS @@ -33,29 +37,28 @@ In general, you will not need to think about this attribute. =cut -{ - use Moose::Util::TypeConstraints; - - has stack_trace => ( - is => 'ro', - isa => duck_type([ qw(as_string) ]), - builder => '_build_stack_trace', - init_arg => undef, - ); - - my $tc = subtype as 'ClassName'; - coerce $tc, from 'Str', via { Class::MOP::load_class($_); $_ }; - - has stack_trace_class => ( - is => 'ro', - isa => $tc, - coerce => 1, - lazy => 1, - builder => '_build_stack_trace_class', - ); +has stack_trace => ( + is => 'ro', + isa => Sub::Quote::quote_sub(q{ + require Scalar::Util; + die "stack_trace must be have an 'as_string' method!" unless + Scalar::Util::blessed($_[0]) && $_[0]->can('as_string') + }), + builder => '_build_stack_trace', + init_arg => undef, +); - no Moose::Util::TypeConstraints; -} +has stack_trace_class => ( + is => 'ro', + isa => Str, + coerce => Sub::Quote::quote_sub(q{ + use Module::Runtime 'require_module'; + require_module($_[0]); + $_[0]; + }), + lazy => 1, + builder => '_build_stack_trace_class', +); =attr stack_trace_args @@ -66,7 +69,7 @@ trace. In general, you will not need to think about it. has stack_trace_args => ( is => 'ro', - isa => 'ArrayRef', + isa => ArrayRef, lazy => 1, builder => '_build_stack_trace_args', ); @@ -105,5 +108,5 @@ sub _build_stack_trace { ); } -no Moose::Role; +no Moo::Role; 1; diff --git a/lib/Throwable.pm b/lib/Throwable.pm index 18d7352..fdf99b9 100644 --- a/lib/Throwable.pm +++ b/lib/Throwable.pm @@ -1,5 +1,9 @@ package Throwable; -use Moose::Role 0.87; +use Moo::Role; +use Sub::Quote (); +use Scalar::Util (); +use Carp (); + # ABSTRACT: a role for classes that can be thrown =head1 SYNOPSIS @@ -30,10 +34,13 @@ Throwable object is created. has 'previous_exception' => ( is => 'ro', init_arg => undef, - default => sub { - return unless defined $@ and (ref $@ or length $@); - return $@; - }, + default => Sub::Quote::quote_sub(q{ + if (defined $@ and (ref $@ or length $@)) { + $@; + } else { + undef; + } + }), ); =method throw @@ -50,8 +57,8 @@ If called on an object that does Throwable, the object will be rethrown. sub throw { my ($inv) = shift; - if (blessed $inv) { - confess "throw called on Throwable object with arguments" if @_; + if (Scalar::Util::blessed($inv)) { + Carp::confess "throw called on Throwable object with arguments" if @_; die $inv; } @@ -59,5 +66,5 @@ sub throw { die $throwable; } -no Moose::Role; +no Moo::Role; 1; diff --git a/lib/Throwable/Error.pm b/lib/Throwable/Error.pm index a4d1ec2..e12699e 100644 --- a/lib/Throwable/Error.pm +++ b/lib/Throwable/Error.pm @@ -1,5 +1,6 @@ package Throwable::Error; -use Moose 0.87; +use Moo; +use MooX::Types::MooseLike::Base qw(Str); with 'Throwable', 'StackTrace::Auto'; # ABSTRACT: an easy-to-use class for error objects @@ -54,7 +55,7 @@ error is stringified. has message => ( is => 'ro', - isa => 'Str', + isa => Str, required => 1, ); @@ -94,6 +95,4 @@ sub BUILDARGS { return $self->SUPER::BUILDARGS(@args); } -__PACKAGE__->meta->make_immutable(inline_constructor => 0); -no Moose; 1; diff --git a/t/basic.t b/t/basic.t index 03fddb4..642cf7c 100644 --- a/t/basic.t +++ b/t/basic.t @@ -5,9 +5,8 @@ use Test::More tests => 11; { package MyError; - use Moose; + use Moo; extends 'Throwable::Error'; - no Moose; } sub throw_x { From 74f34203555054a994a12ebc762094ec0b63eba7 Mon Sep 17 00:00:00 2001 From: Arthur Axel 'fREW' Schmidt Date: Wed, 29 Aug 2012 12:42:10 -0500 Subject: [PATCH 05/11] "fix" test --- t/basic.t | 2 -- 1 file changed, 2 deletions(-) diff --git a/t/basic.t b/t/basic.t index 642cf7c..3411894 100644 --- a/t/basic.t +++ b/t/basic.t @@ -17,8 +17,6 @@ sub call_throw_x { throw_x; } -warn MyError->new({ message => 'm' }); - eval { call_throw_x; }; my $error = $@; From 8962265c2f393478aab10e6c430d42a434540f97 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dagfinn=20Ilmari=20Manns=C3=A5ker?= Date: Thu, 30 Aug 2012 20:36:17 +0100 Subject: [PATCH 06/11] Ignore editor droppings --- .gitignore | 3 +++ 1 file changed, 3 insertions(+) diff --git a/.gitignore b/.gitignore index c825213..c0ecbf7 100644 --- a/.gitignore +++ b/.gitignore @@ -1,2 +1,5 @@ .build Throwable-* +*~ +.#* +*# From cdb1a79bd969db7611bd4dfafde685fd67374692 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dagfinn=20Ilmari=20Manns=C3=A5ker?= Date: Thu, 30 Aug 2012 20:37:46 +0100 Subject: [PATCH 07/11] Filter out all frames before our constructor(s) This makes it work regardless of the internal call chain in the build process, and thus for both Moo and Moose consumers. --- lib/StackTrace/Auto.pm | 18 +++++++++++------- t/basic.t | 41 +++++++++++++++++++++++++++++++++++------ xt/moose.t | 6 ++++++ 3 files changed, 52 insertions(+), 13 deletions(-) create mode 100644 xt/moose.t diff --git a/lib/StackTrace/Auto.pm b/lib/StackTrace/Auto.pm index 60277bb..6c8e809 100644 --- a/lib/StackTrace/Auto.pm +++ b/lib/StackTrace/Auto.pm @@ -84,16 +84,20 @@ sub _build_stack_trace_args { return [ frame_filter => sub { my ($raw) = @_; - if ($found_mark == 2) { + my $sub = $raw->{caller}->[3]; + (my $package = $sub) =~ s/::\w+\z//; + if ($found_mark == 3) { return 1; } - elsif ($found_mark == 1) { - if ($raw->{caller}->[3] =~ /::new$/) { - $found_mark = 2; - return 0; - } + elsif ($found_mark == 2) { + return 0 if $sub =~ /::new$/ && $self->isa($package); + $found_mark++; + return 1; + } elsif ($found_mark == 1) { + $found_mark++ if $sub =~ /::new$/ && $self->isa($package); return 0; - } else { + } + else { $found_mark++ if $raw->{caller}->[3] =~ /::_build_stack_trace$/; return 0; } diff --git a/t/basic.t b/t/basic.t index 3411894..c178d31 100644 --- a/t/basic.t +++ b/t/basic.t @@ -1,12 +1,23 @@ #!perl use strict; use warnings; -use Test::More tests => 11; +use Test::More; -{ - package MyError; - use Moo; - extends 'Throwable::Error'; +my $extra_frames; +BEGIN { + my $class = 'Moo'; + $extra_frames = 0; + if ($Throwable::_TEST_MOOSE) { + $class = 'Moose'; + $extra_frames++ # the "do" in xt/moose.t adds a frame + } + eval qq{ + package MyError; + use $class; + extends 'Throwable::Error'; + + 1; + } or die $@; } sub throw_x { @@ -30,7 +41,7 @@ my $trace = $error->stack_trace; isa_ok($trace, 'Devel::StackTrace', 'the trace'); my @frames = $trace->frames; -is(@frames, 4, "we have four frames in our trace"); +is(@frames, 4 + $extra_frames, "we have four frames in our trace"); is($frames[0]->subroutine, q{Throwable::throw}, 'correct frame 0'); is($frames[1]->subroutine, q{main::throw_x}, 'correct frame 1'); is($frames[2]->subroutine, q{main::call_throw_x}, 'correct frame 2'); @@ -43,3 +54,21 @@ is($frames[3]->subroutine, q{(eval)}, 'correct frame 3'); isa_ok($error, 'MyError', 'the error'); is($error->message, q{shucks howdy}, "error message is correct"); } + +{ + package HasError; + sub new { bless { error => MyError->new("flabba") } } +} + +sub create_error { HasError->new->{error} } + +{ + my $error = create_error(); + + my @frames = $error->stack_trace->frames; + is(@frames, 2 + $extra_frames, "two frames from constructor"); + is($frames[0]->subroutine, q{HasError::new}, 'correct constructor in frame 0'); + is($frames[1]->subroutine, q{main::create_error}, 'correct frame 1'); +} + +done_testing(); diff --git a/xt/moose.t b/xt/moose.t new file mode 100644 index 0000000..475cc9a --- /dev/null +++ b/xt/moose.t @@ -0,0 +1,6 @@ +#perl +use strict; +use warnings; + +$Throwable::_TEST_MOOSE = 1; +do "t/basic.t"; From 39237212b185853a0170b51061ebeeb9f4895060 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dagfinn=20Ilmari=20Manns=C3=A5ker?= Date: Fri, 31 Aug 2012 03:21:45 +0100 Subject: [PATCH 08/11] Tighten isa check for stack_trace_class attr When consumed into a Moose class, attributes declared in a Moo::Role get the Moose behaviour of only calling coerce if isa fails, so the class wouldn't get loaded with the lax isa check. --- lib/StackTrace/Auto.pm | 13 +++++++------ xt/moose-coerce-class.t | 18 ++++++++++++++++++ 2 files changed, 25 insertions(+), 6 deletions(-) create mode 100644 xt/moose-coerce-class.t diff --git a/lib/StackTrace/Auto.pm b/lib/StackTrace/Auto.pm index 6c8e809..e75845a 100644 --- a/lib/StackTrace/Auto.pm +++ b/lib/StackTrace/Auto.pm @@ -1,8 +1,8 @@ package StackTrace::Auto; use Moo::Role; use Sub::Quote (); -use MooX::Types::MooseLike::Base qw(Str ArrayRef); -use Module::Runtime 'require_module'; +use MooX::Types::MooseLike::Base qw(ArrayRef); +use Class::Load (); # ABSTRACT: a role for generating stack traces during instantiation @@ -50,11 +50,12 @@ has stack_trace => ( has stack_trace_class => ( is => 'ro', - isa => Str, + isa => Sub::Quote::quote_sub(q{ + die "stack_trace_class must be a loaded class" + unless Class::Load::is_class_loaded($_[0]); + }), coerce => Sub::Quote::quote_sub(q{ - use Module::Runtime 'require_module'; - require_module($_[0]); - $_[0]; + Class::Load::load_class($_[0]); }), lazy => 1, builder => '_build_stack_trace_class', diff --git a/xt/moose-coerce-class.t b/xt/moose-coerce-class.t new file mode 100644 index 0000000..beae9c1 --- /dev/null +++ b/xt/moose-coerce-class.t @@ -0,0 +1,18 @@ +#!perl +use strict; +use warnings; +use Test::More; + +{ + package MyClass; + use Moose; + with 'StackTrace::Auto'; +} + +ok(my $obj = eval { MyClass->new }, "Create Moose object") + or diag $@; + +isa_ok($obj, "MyClass"); +isa_ok($obj->stack_trace, "Devel::StackTrace", 'The trace'); + +done_testing(); From 515f76f87ca14ad215b930c255cfcea84a57da3a Mon Sep 17 00:00:00 2001 From: Arthur Axel 'fREW' Schmidt Date: Sat, 1 Sep 2012 11:35:07 -0500 Subject: [PATCH 09/11] give credit where credit is due --- Changes | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Changes b/Changes index 06999bc..57ac72c 100644 --- a/Changes +++ b/Changes @@ -1,7 +1,7 @@ Revision history for Throwable {{$NEXT}} - port to Moo + port to Moo (FREW, MSTROUT, ILMARI) 0.102080 2010-07-27 12:09:21 America/New_York refactor stack trace autocreation to StackTrace::Auto role From 87ba458eac7a9776878d8dc38a6c7fdd6fe5fbf7 Mon Sep 17 00:00:00 2001 From: Ricardo Signes Date: Thu, 20 Sep 2012 14:12:45 -0400 Subject: [PATCH 10/11] v0.200000 port to Moo (FREW, MSTROUT, ILMARI) --- Changes | 2 ++ 1 file changed, 2 insertions(+) diff --git a/Changes b/Changes index 57ac72c..8562009 100644 --- a/Changes +++ b/Changes @@ -1,6 +1,8 @@ Revision history for Throwable {{$NEXT}} + +0.200000 2012-09-20 14:12:34 America/New_York port to Moo (FREW, MSTROUT, ILMARI) 0.102080 2010-07-27 12:09:21 America/New_York From 82c0c0004353feefbe37e2786d7100a3b6679ad2 Mon Sep 17 00:00:00 2001 From: fREW Schmidt Date: Sat, 22 Sep 2012 09:05:25 -0500 Subject: [PATCH 11/11] Add missing deps --- dist.ini | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/dist.ini b/dist.ini index fe07476..389d9e7 100644 --- a/dist.ini +++ b/dist.ini @@ -8,4 +8,4 @@ copyright_holder = Ricardo SIGNES [Prereqs] Devel::StackTrace = 1.21 ; frame_filter - +Class::Load = 0.20