# Debugger for Perl 5.00x; perl5db.pl patch level:
-$VERSION = 1.03;
+$VERSION = 1.0402;
$header = "perl5db.pl version $VERSION";
# Enhanced by ilya@math.ohio-state.edu (Ilya Zakharevich)
TTY noTTY ReadLine NonStop LineInfo maxTraceLen
recallCommand ShellBang pager tkRunning ornaments
signalLevel warnLevel dieLevel inhibit_exit
- ImmediateStop);
+ ImmediateStop bareStringify);
%optionVars = (
hashDepth => \$dumpvar::hashDepth,
undefPrint => \$dumpvar::printUndef,
globPrint => \$dumpvar::globPrint,
UsageOnly => \$dumpvar::usageOnly,
+ bareStringify => \$dumpvar::bareStringify,
frame => \$frame,
AutoTrace => \$trace,
inhibit_exit => \$inhibit_exit,
# _After_ the perl program is compiled, $single is set to 1:
if ($single and not $second_time++) {
if ($runnonstop) { # Disable until signal
- for ($i=0; $i <= $#stack; ) {
+ for ($i=0; $i <= $stack_depth; ) {
$stack[$i++] &= ~1;
}
$single = 0;
if ($trace & 2) {
for (my $n = 0; $n <= $#to_watch; $n++) {
$evalarg = $to_watch[$n];
+ local $onetimeDump; # Do not output results
my ($val) = &eval; # Fix context (&eval is doing array)?
$val = ( (defined $val) ? "'$val'" : 'undef' );
if ($val ne $old_watch[$n]) {
$position = "$prefix$line$infix$dbline[$line]$after";
}
if ($frame) {
- print $LINEINFO ' ' x $#stack, "$line:\t$dbline[$line]$after";
+ print $LINEINFO ' ' x $stack_depth, "$line:\t$dbline[$line]$after";
} else {
print $LINEINFO $position;
}
$incr_pos = "$prefix$i$infix$dbline[$i]$after";
$position .= $incr_pos;
if ($frame) {
- print $LINEINFO ' ' x $#stack, "$i:\t$dbline[$i]$after";
+ print $LINEINFO ' ' x $stack_depth, "$i:\t$dbline[$i]$after";
} else {
print $LINEINFO $incr_pos;
}
foreach $evalarg (@$pre) {
&eval;
}
- print $OUT $#stack . " levels deep in subroutine calls!\n"
+ print $OUT $stack_depth . " levels deep in subroutine calls!\n"
if $single & 4;
$start = $line;
$incr = -1; # for backward motion.
}
$dbline{$i} =~ s/($|\0)/;9$1/; # add one-time-only b.p.
}
- for ($i=0; $i <= $#stack; ) {
+ for ($i=0; $i <= $stack_depth; ) {
$stack[$i++] &= ~1;
}
last CMD; };
$cmd =~ /^r$/ && do {
end_report(), next CMD if $finished and $level <= 1;
- $stack[$#stack] |= 1;
- $doret = $option{PrintRet} ? $#stack - 1 : -2;
+ $stack[$stack_depth] |= 1;
+ $doret = $option{PrintRet} ? $stack_depth - 1 : -2;
last CMD; };
$cmd =~ /^R$/ && do {
print $OUT "Warning: some settings and command-line options may be lost!\n";
$cmd =~ /^$rc+\s*(-)?(\d+)?$/ && do {
pop(@hist) if length($cmd) > 1;
$i = $1 ? ($#hist-($2?$2:1)) : ($2?$2:$#hist);
- $cmd = $hist[$i] . "\n";
+ $cmd = $hist[$i];
print $OUT $cmd;
redo CMD; };
$cmd =~ /^$sh$sh\s*([\x00-\xff]*)/ && do {
print $OUT "No such command!\n\n";
next CMD;
}
- $cmd = $hist[$i] . "\n";
+ $cmd = $hist[$i];
print $OUT $cmd;
redo CMD; };
$cmd =~ /^$sh$/ && do {
if (length($sub) > 10 && substr($sub, -10, 10) eq '::AUTOLOAD') {
$al = " for $$sub";
}
- push(@stack, $single);
+ local $stack_depth = $stack_depth + 1; # Protect from non-local exits
+ $#stack = $stack_depth;
+ $stack[-1] = $single;
$single &= 1;
- $single |= 4 if $#stack == $deep;
+ $single |= 4 if $stack_depth == $deep;
($frame & 4
- ? ( (print $LINEINFO ' ' x ($#stack - 1), "in "),
+ ? ( (print $LINEINFO ' ' x ($stack_depth - 1), "in "),
# Why -1? But it works! :-(
print_trace($LINEINFO, -1, 1, 1, "$sub$al") )
- : print $LINEINFO ' ' x ($#stack - 1), "entering $sub$al\n") if $frame;
+ : print $LINEINFO ' ' x ($stack_depth - 1), "entering $sub$al\n") if $frame;
if (wantarray) {
@ret = &$sub;
- $single |= pop(@stack);
+ $single |= $stack[$stack_depth--];
($frame & 4
- ? ( (print $LINEINFO ' ' x $#stack, "out "),
+ ? ( (print $LINEINFO ' ' x $stack_depth, "out "),
print_trace($LINEINFO, -1, 1, 1, "$sub$al") )
- : print $LINEINFO ' ' x $#stack, "exited $sub$al\n") if $frame & 2;
- if ($doret eq $#stack or $frame & 16) {
- my $fh = ($doret eq $#stack ? $OUT : $LINEINFO);
- print $fh ' ' x $#stack if $frame & 16;
+ : print $LINEINFO ' ' x $stack_depth, "exited $sub$al\n") if $frame & 2;
+ if ($doret eq $stack_depth or $frame & 16) {
+ my $fh = ($doret eq $stack_depth ? $OUT : $LINEINFO);
+ print $fh ' ' x $stack_depth if $frame & 16;
print $fh "list context return from $sub:\n";
dumpit($fh, \@ret );
$doret = -2;
} else {
&$sub; undef $ret;
};
- $single |= pop(@stack);
+ $single |= $stack[$stack_depth--];
($frame & 4
- ? ( (print $LINEINFO ' ' x $#stack, "out "),
+ ? ( (print $LINEINFO ' ' x $stack_depth, "out "),
print_trace($LINEINFO, -1, 1, 1, "$sub$al") )
- : print $LINEINFO ' ' x $#stack, "exited $sub$al\n") if $frame & 2;
- if ($doret eq $#stack or $frame & 16 and defined wantarray) {
- my $fh = ($doret eq $#stack ? $OUT : $LINEINFO);
- print $fh (' ' x $#stack) if $frame & 16;
+ : print $LINEINFO ' ' x $stack_depth, "exited $sub$al\n") if $frame & 2;
+ if ($doret eq $stack_depth or $frame & 16 and defined wantarray) {
+ my $fh = ($doret eq $stack_depth ? $OUT : $LINEINFO);
+ print $fh (' ' x $stack_depth) if $frame & 16;
print $fh (defined wantarray
? "scalar context return from $sub: "
: "void context return from $sub\n");
sub eval {
my @res;
{
- local (@stack) = @stack; # guard against recursive debugging
my $otrace = $trace;
my $osingle = $single;
my $od = $^D;
$filename =~ s/^_<//;
$signal = 1, print $OUT "'$filename' loaded...\n"
if $break_on_load{$filename};
- print $LINEINFO ' ' x $#stack, "Package $filename.\n" if $frame;
+ print $LINEINFO ' ' x $stack_depth, "Package $filename.\n" if $frame;
return unless $postponed_file{$filename};
$had_breakpoints{$filename}++;
#%dbline = %{$postponed_file{$filename}}; # Cannot be done: unsufficient magic
sub setterm {
local $frame = 0;
local $doret = -2;
- local @stack = @stack; # Prevent growth by failing `use'.
eval { require Term::ReadLine } or die $@;
if ($notty) {
if ($tty) {
I<DumpPackages>: dump symbol tables of packages;
I<DumpReused>: dump contents of \"reused\" addresses;
I<quote>, I<HighBit>, I<undefPrint>: change style of string dump;
+ I<bareStringify>: Do not print the overload-stringified value;
Option I<PrintRet> affects printing of return value after B<r> command,
I<frame> affects printing messages on entry and exit from subroutines.
I<AutoTrace> affects printing messages on every possible breaking point.
# @stack and $doret are needed in sub sub, which is called for DB::postponed.
# Triggers bug (?) in perl is we postpone this until runtime:
@postponed = @stack = (0);
+ $stack_depth = 0; # Localized $#stack
$doret = -2;
$frame = 0;
}