Permalink
Browse files

Start looking at 116358. For us it's a stack counting bug.

  • Loading branch information...
1 parent 16384ae commit 2a7196b8af740e19018b9f5563bb9ed9c446de07 Rocky Bernstein committed Jan 14, 2013
View
@@ -18,7 +18,7 @@ use Exporter;
use constant PROGRAM => 'trepan.pl';
use version;
-$VERSION='0.48'; # To fool CPAN indexer. Is <= real version
+$VERSION='0.48_01'; # To fool CPAN indexer. Is <= real version
$VERSION = $Devel::Trepan::Version::VERSION;
$PROGRAM = PROGRAM;
@@ -93,19 +93,19 @@ sub print_stack_trace_from_to($$$$$)
# Print `count' frame entries
sub print_stack_trace($$$)
{
- my ($self, $frame, $opts)=@_;
+ my ($self, $frames, $opts)=@_;
$opts ||= {maxstack=>1e9, count=>1e9};
# $opts = DEFAULT_STACK_TRACE_SETTINGS.merge(opts);
my $halfstack = $opts->{maxstack} / 2;
- my $n = scalar @{$frame};
+ my $n = scalar @{$frames};
$n = $opts->{count} if $opts->{count} < $n;
if ($n > ($halfstack * 2)) {
- $self->print_stack_trace_from_to(0, $halfstack-1, $frame, $opts);
+ $self->print_stack_trace_from_to(0, $halfstack-1, $frames, $opts);
my $msg = sprintf "... %d levels ...", ($n - $halfstack*2);
$self->msg($msg);
- $self->print_stack_trace_from_to($n - $halfstack, $n-1, $frame, $opts);
+ $self->print_stack_trace_from_to($n - $halfstack, $n-1, $frames, $opts);
} else {
- $self->print_stack_trace_from_to(0, $n-1, $frame, $opts);
+ $self->print_stack_trace_from_to(0, $n-1, $frames, $opts);
}
}
@@ -73,8 +73,8 @@ sub backtrace($;$$$) {
}
}
- # print "++count: $count, i $iline\n";
$count += $i;
+ # print "++count: $count, i $i\n";
my ( @a, $args_ary );
my @callstack = ();
@@ -91,8 +91,8 @@ sub backtrace($;$$$) {
# Up the stack frame index to go back one more level each time.
while ($i <= $count and
($pkg, $file, $line, $fn, $hasargs, $wantarray, $evaltext, $is_require) = caller($i)) {
- next if $pkg eq 'DB' && 'fn' eq 'sub';
- # print "++file: $file, line $line $fn\n";
+ next if $pkg eq 'DB' && ($fn eq 'sub' || $fn eq 'lsub');
+ ## print "++file: $file, line $line $fn\n" if $DB::DEBUGME;
$i++;
# Go through the arguments and save them for later.
@a = ();
@@ -180,7 +180,7 @@ sub backtrace($;$$$) {
# last if $signal;
} ## end for ($i = $skip ; $i < ...
- # The function and args for the stopped line is DB:DB,
+ # The function and args for the stopped line is DB::DB,
# but we want it to be the function and args of the last call.
# And the function and args for the file and line that called us
# should also be the prior function and args.
View
@@ -43,7 +43,7 @@ sub sub {
# return value in (if needed).
my ( $al, $ret, @ret ) = "";
if ($sub eq 'threads::new' && $ENV{PERL5DB_THREADED}) {
- print "creating new thread\n";
+ print "creating new thread\n";
}
# If the last ten characters are '::AUTOLOAD', note we've traced
@@ -80,8 +80,10 @@ sub sub {
}
elsif (wantarray) {
# Called in array context. call sub and capture output.
- # DB::DB will recursively get control again if appropriate; we'll come
- # back here when the sub is finished.
+ # DB::DB will recursively get control again if appropriate;
+ # we'll come back here when the sub is finished.
+
+ # call the original lvalue sub.
@ret = &$sub;
# Pop the single-step value back off the stack.
@@ -93,20 +95,19 @@ sub sub {
return @DB::return_value;
}
@ret;
- }
- else {
+ } else {
if ( defined wantarray ) {
- # Save the value if it's wanted at all.
+ # Call the original lvalue sub and save the scalar value.
$ret = &$sub;
- }
- else {
- # Void return, explicitly.
+ } else {
+ # Call the original lvalue sub and explicitly void the return
+ # value.
&$sub;
undef $ret;
}
# Pop the single-step value back off the stack.
- $single |= $stack[ $stack_depth-- ] if $stack[$stack_depth];
+ $DB::single |= $stack[ $stack_depth-- ] if $stack[$stack_depth];
if ($single & RETURN_EVENT) {
$DB::return_type = defined $ret ? 'scalar' : 'undef';
$DB::return_value = $ret;
@@ -115,53 +116,90 @@ sub sub {
}
# Return the appropriate scalar value.
- $ret;
+ return $ret;
}
}
sub lsub : lvalue {
+ # Possibly [perl #66110] also applies here as in sub.
# lock ourselves under threads
lock($DBGR);
-
+
# Whether or not the autoloader was running, a scalar to put the
# sub's return value in (if needed), and an array to put the sub's
# return value in (if needed).
my ( $al, $ret, @ret ) = "";
- if ($sub =~ /^threads::new$/ && $ENV{PERL5DB_THREADED}) {
+ if ($sub eq 'threads::new' && $ENV{PERL5DB_THREADED}) {
print "creating new thread\n";
}
- # If the last ten characters are C'::AUTOLOAD', note we've traced
+ # If the last ten characters are '::AUTOLOAD', note we've traced
# into AUTOLOAD for $sub.
if ( length($sub) > 10 && substr( $sub, -10, 10 ) eq '::AUTOLOAD' ) {
- $al = " for $$sub";
+ $al = " for $$sub" if defined $$sub;;
}
# We stack the stack pointer and then increment it to protect us
# from a situation that might unwind a whole bunch of call frames
# at once. Localizing the stack pointer means that it will automatically
# unwind the same amount when multiple stack frames are unwound.
local $stack_depth = $stack_depth + 1; # Protect from non-local exits
-
+
# Expand @stack.
$#stack = $stack_depth;
-
+
# Save current single-step setting.
- $stack[-1] = $single;
+ $stack[-1] = $DB::single;
- # Turn off all flags except single-stepping.
- $single &= SINGLE_STEPPING_EVENT;
+ # printf "++ \$DB::single for $sub: 0%x\n", $DB::single if $DB::single;
+ # Turn off all flags except single-stepping or return event.
+ $DB::single &= SINGLE_STEPPING_EVENT;
# If we've gotten really deeply recursed, turn on the flag that will
# make us stop with the 'deep recursion' message.
- $single |= DEEP_RECURSION_EVENT if $stack_depth == $deep;
+ $DB::single |= DEEP_RECURSION_EVENT if $#stack == $deep;
# Pop the single-step value back off the stack.
- $single |= $stack[ $stack_depth-- ];
+ $DB::single |= $stack[ $stack_depth-- ] if $stack[$stack_depth];
- # call the original lvalue sub.
- &$sub;
+ if (wantarray) {
+ # Called in array context. call sub and capture output.
+ # DB::DB will recursively get control again if appropriate; we'll come
+ # back here when the sub is finished.
+ @ret = &$sub;
+
+ # Pop the single-step value back off the stack.
+ $DB::single |= $stack[ $stack_depth-- ];
+ if ($single & RETURN_EVENT) {
+ $DB::return_type = 'array';
+ @DB::return_value = @ret;
+ DB::DB($DB::sub) ;
+ return @DB::return_value;
+ }
+ @ret;
+ } else {
+ if ( defined wantarray ) {
+ # Save the value if it's wanted at all.
+ $ret = &$sub;
+ } else {
+ # Void return, explicitly.
+ &$sub;
+ undef $ret;
+ }
+
+ # Pop the single-step value back off the stack.
+ $DB::single |= $stack[ $stack_depth-- ] if $stack[$stack_depth];
+ if ($single & RETURN_EVENT) {
+ $DB::return_type = defined $ret ? 'scalar' : 'undef';
+ $DB::return_value = $ret;
+ DB::DB($DB::sub) ;
+ return $DB::return_value;
+ }
+
+ # Return the appropriate scalar value.
+ return $ret;
+ }
}
####
@@ -80,6 +80,7 @@ sub frame_setup($$)
}
$stack_size++;
$DB::stack_depth = $j;
+ $stack_size -= ($j-3);
} else {
$stack_size -= ($i-3);
}
@@ -1,3 +1,3 @@
package Devel::Trepan::Version;
-use version; $VERSION = '0.48';
+use version; $VERSION = '0.48_01';
1;

0 comments on commit 2a7196b

Please sign in to comment.