# Debugger for Perl 5.00x; perl5db.pl patch level:
use vars qw($VERSION $header);
-$VERSION = '1.39_10';
+$VERSION = '1.40';
$header = "perl5db.pl version $VERSION";
# Since we're only saving $@, we only have to localize the array element
# that it will be stored in.
local $saved[0]; # Preserve the old value of $@
- eval { DB::save() };
+ eval { &DB::save };
# Now see whether we need to report an error back to the user.
if ($at) {
# see if we should stop. If so, remove the one-time sigil.
elsif ($stop) {
$evalarg = "\$DB::signal |= 1 if do {$stop}";
- DB::eval();
+ # The &-call is here to ascertain the mutability of @_.
+ &DB::eval;
# If the breakpoint is temporary, then delete its enabled status.
if ($dbline{$line} =~ s/;9($|\0)/$1/) {
_cancel_breakpoint_temp_enabled_status($filename, $line);
{ t => 's', v => \&_DB__handle_restart_and_rerun_commands, },
} qw(R rerun)),
(map { $_ => {t => 'm', v => '_handle_cmd_wrapper_commands' }, }
- qw(a A b B e E h i l L M o O P v w W)),
+ qw(a A b B e E h i l L M o O v w W)),
);
sub DB {
# Last line in the program.
$max = $#dbline;
- _DB__determine_if_we_should_break(@_);
+ # The &-call is here to ascertain the mutability of @_.
+ &_DB__determine_if_we_should_break;
# Preserve the current stop-or-not, and see if any of the W
# (watch expressions) has changed.
# If there's an action, do it now.
if ($action) {
$evalarg = $action;
- DB::eval();
+ # The &-call is here to ascertain the mutability of @_.
+ &DB::eval;
}
# Are we nested another level (e.g., did we evaluate a function
# Do any pre-prompt actions.
foreach $evalarg (@$pre) {
- DB::eval();
+ # The &-call is here to ascertain the mutability of @_.
+ &DB::eval;
}
# Complain about too much recursion if we passed the limit.
$evalarg = "\$^D = \$^D | \$DB::db_stop;\n$cmd";
# Run *our* eval that executes in the caller's context.
- DB::eval();
+ # The &-call is here to ascertain the mutability of @_.
+ &DB::eval;
# Turn off the one-time-dump stuff now.
if ($onetimeDump) {
# Evaluate post-prompt commands.
foreach $evalarg (@$post) {
- DB::eval();
+ # The &-call is here to ascertain the mutability of @_.
+ &DB::eval;
}
} # if ($single || $signal)
my $line = shift;
foreach my $isa ( split( /\s+/, $line ) ) {
$evalarg = $isa;
- ($isa) = DB::eval();
+ # The &-call is here to ascertain the mutability of @_.
+ ($isa) = &DB::eval;
no strict 'refs';
print join(
', ',
# in the user's context. This version can handle expressions which
# return a list value.
$evalarg = $expr;
- my ($val) = join( ' ', DB::eval() );
+ # The &-call is here to ascertain the mutability of @_.
+ my ($val) = join( ' ', &DB::eval);
$val = ( defined $val ) ? "'$val'" : 'undef';
# Save the current value of the expression.
=cut
-my %_is_in_pods = (map { $_ => 1 }
- qw(
- 5004delta
- 5005delta
- 561delta
- 56delta
- 570delta
- 571delta
- 572delta
- 573delta
- 58delta
- 581delta
- 582delta
- 583delta
- 584delta
- 590delta
- 591delta
- 592delta
- aix
- amiga
- apio
- api
- artistic
- book
- boot
- bot
- bs2000
- call
- ce
- cheat
- clib
- cn
- compile
- cygwin
- data
- dbmfilter
- debguts
- debtut
- debug
- delta
- dgux
- diag
- doc
- dos
- dsc
- ebcdic
- embed
- faq1
- faq2
- faq3
- faq4
- faq5
- faq6
- faq7
- faq8
- faq9
- faq
- filter
- fork
- form
- freebsd
- func
- gpl
- guts
- hack
- hist
- hpux
- hurd
- intern
- intro
- iol
- ipc
- irix
- jp
- ko
- lexwarn
- locale
- lol
- macos
- macosx
- modinstall
- modlib
- mod
- modstyle
- netware
- newmod
- number
- obj
- opentut
- op
- os2
- os390
- os400
- packtut
- plan9
- pod
- podspec
- port
- qnx
- ref
- reftut
- re
- requick
- reref
- retut
- run
- sec
- solaris
- style
- sub
- syn
- thrtut
- tie
- toc
- todo
- tooc
- toot
- trap
- tru64
- tw
- unicode
- uniintro
- util
- uts
- var
- vms
- vos
- win32
- xs
- xstut
- )
-);
-
sub runman {
my $page = shift;
unless ($page) {
$page = 'perl' if lc($page) eq 'help';
require Config;
- my $man1dir = $Config::Config{'man1dir'};
- my $man3dir = $Config::Config{'man3dir'};
+ my $man1dir = $Config::Config{man1direxp};
+ my $man3dir = $Config::Config{man3direxp};
for ( $man1dir, $man3dir ) { s#/[^/]*\z## if /\S/ }
my $manpath = '';
$manpath .= "$man1dir:" if $man1dir =~ /\S/;
chop $manpath if $manpath;
# harmless if missing, I figure
- my $oldpath = $ENV{MANPATH};
- $ENV{MANPATH} = $manpath if $manpath;
+ local $ENV{MANPATH} = $manpath if $manpath;
my $nopathopt = $^O =~ /dunno what goes here/;
if (
CORE::system(
)
{
unless ( $page =~ /^perl\w/ ) {
-# do it this way because its easier to slurp in to keep up to date - clunky though.
- if (exists($_is_in_pods{$page})) {
+ # Previously the debugger contained a list which it slurped in,
+ # listing the known "perl" manpages. However, it was out of date,
+ # with errors both of omission and inclusion. This approach is
+ # considerably less complex. The failure mode on a butchered
+ # install is simply that the user has to run man or perldoc
+ # "manually" with the full manpage name.
+
+ # There is a list of $^O values in installperl to determine whether
+ # the directory is 'pods' or 'pod'. However, we can avoid tight
+ # coupling to that by simply checking the "non-standard" 'pods'
+ # first.
+ my $pods = "$Config::Config{privlibexp}/pods";
+ $pods = "$Config::Config{privlibexp}/pod"
+ unless -d $pods;
+ if (-f "$pods/perl$page.pod") {
CORE::system( $doccmd,
( ( $manpath && !$nopathopt ) ? ( "-M", $manpath ) : () ),
"perl$page" );
}
}
} ## end if (CORE::system($doccmd...
- if ( defined $oldpath ) {
- $ENV{MANPATH} = $manpath;
- }
- else {
- delete $ENV{MANPATH};
- }
} ## end sub runman
#use Carp; # This did break, left for debugging
# This defines the point at which you get the 'deep recursion'
# warning. It MUST be defined or the debugger will not load.
- $deep = 100;
+ $deep = 1000;
# Number of lines around the current one that are shown in the
# 'w' command.
# Get the current value of the expression.
# Doesn't handle expressions returning list values!
$evalarg = $1;
- my ($val) = DB::eval();
+ # The &-call is here to ascertain the mutability of @_.
+ my ($val) = &DB::eval;
$val = ( defined $val ) ? "'$val'" : 'undef';
# Save it.
https://perl5.git.perl.org / perl5.git / blobdiff