| Subject: | Allow skipping of frames at the top of the trace |
There should be a way to skip frames at the top of a stack trace, until
some condition is met. That's useful for other objects storing
Devel::StackTrace instances inside them and constructing them when they
are constructed. Most of the time they don't want the stack frames of
their own construction in their Devel::StackTrace. Throwable is one
example for this.
| Subject: | 0001-Add-possibility-to-determine-the-start-of-the-trace-.patch |
From 21c65217ea1f2282af167e90cbfba681b18c354b Mon Sep 17 00:00:00 2001
From: Florian Ragwitz <rafl@debian.org>
Date: Tue, 16 Jun 2009 00:52:10 +0200
Subject: [PATCH 1/2] Add possibility to determine the start of the trace using a callback.
---
lib/Devel/StackTrace.pm | 12 +++++++++---
t/03-skip-start.t | 30 ++++++++++++++++++++++++++++++
2 files changed, 39 insertions(+), 3 deletions(-)
create mode 100644 t/03-skip-start.t
diff --git a/lib/Devel/StackTrace.pm b/lib/Devel/StackTrace.pm
index 90df0f6..e96c317 100644
--- a/lib/Devel/StackTrace.pm
+++ b/lib/Devel/StackTrace.pm
@@ -26,9 +26,10 @@ sub new
if exists $p{no_object_refs};
my $self =
- bless { index => undef,
- frames => [],
- raw => [],
+ bless { index => undef,
+ frames => [],
+ raw => [],
+ find_start_frame => sub { 1 },
%p,
}, $class;
@@ -118,8 +119,13 @@ sub _make_frames
push @i_pack_re, qr/^\Q$p\E$/;
my $raw = delete $self->{raw};
+ my $found_start = 0;
+
for my $r ( @{$raw} )
{
+ $found_start ||= $self->{find_start_frame}->($r);
+ next unless $found_start;
+
next if grep { $r->{caller}[0] =~ /$_/ } @i_pack_re;
next if grep { $r->{caller}[0]->isa($_) } keys %i_class;
diff --git a/t/03-skip-start.t b/t/03-skip-start.t
new file mode 100644
index 0000000..a54271b
--- /dev/null
+++ b/t/03-skip-start.t
@@ -0,0 +1,30 @@
+use strict;
+use warnings;
+
+use Test::More tests => 4;
+
+use Devel::StackTrace;
+
+sub foo
+{
+ bar();
+}
+
+sub bar
+{
+ my $i = 0;
+ return (
+ Devel::StackTrace->new,
+ Devel::StackTrace->new(find_start_frame => sub { $i++ }),
+ );
+}
+
+my @frames = map { [$_->frames] } foo();
+is(scalar @{ $frames[0] }, 3);
+is(scalar @{ $frames[1] }, 2);
+
+shift @{ $frames[0] };
+for my $i (0 .. $#{ $frames[0] })
+{
+ is($frames[0]->[$i]->as_string, $frames[1]->[$i]->as_string);
+}
--
1.6.3.1.57.gbd5ef