summaryrefslogtreecommitdiff
path: root/lib/perl5db.pl
diff options
context:
space:
mode:
authorTony Cook <tony@develop-help.com>2020-03-30 16:32:46 +1100
committerTony Cook <tony@develop-help.com>2020-08-10 04:47:53 +0000
commitb334474a337421c6643b872388245fb2c11bf995 (patch)
tree54ad3892922256baa57f6b9981fa360c71b0403e /lib/perl5db.pl
parent55507ac1d99efa7f407df8ebcf9f6683532679f8 (diff)
downloadperl-b334474a337421c6643b872388245fb2c11bf995.tar.gz
fix C<i $obj> where $obj is a lexical
the DB::eval function depends on the special behaviour of eval "" within the DB package, which evaluates the string within the context of the first non-DB sub or eval scope, working up the call stack. The debugger refactor moved handling for the 'i' command from the DB package to the DB::Obj package, so the eval in DB::eval was working in the context of the DB::Obj::cmd_i function, not in the calling scope. Fixed by moving the handling for the i command back to DB. Fixes #17661.
Diffstat (limited to 'lib/perl5db.pl')
-rw-r--r--lib/perl5db.pl65
1 files changed, 33 insertions, 32 deletions
diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index 96e56d559f..b647d24fb8 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -2512,6 +2512,37 @@ EOP
return;
}
+=head3 C<_DB__handle_i_command> - inheritance display
+
+Display the (nested) parentage of the module or object given.
+
+=cut
+
+sub _DB__handle_i_command {
+ my $self = shift;
+
+ my $line = $self->cmd_args;
+ require mro;
+ foreach my $isa ( split( /\s+/, $line ) ) {
+ $evalarg = "$isa";
+ # The &-call is here to ascertain the mutability of @_.
+ ($isa) = &DB::eval;
+ no strict 'refs';
+ print join(
+ ', ',
+ map {
+ "$_"
+ . (
+ defined( ${"$_\::VERSION"} )
+ ? ' ' . ${"$_\::VERSION"}
+ : undef )
+ } @{mro::get_linear_isa(ref($isa) || $isa)}
+ );
+ print "\n";
+ }
+ next CMD;
+}
+
# 't' is type.
# 'm' is method.
# 'v' is the value (i.e: method name or subroutine ref).
@@ -2531,6 +2562,7 @@ BEGIN
'W' => { t => 'm', v => '_handle_W_command', },
'c' => { t => 's', v => \&_DB__handle_c_command, },
'f' => { t => 's', v => \&_DB__handle_f_command, },
+ 'i' => { t => 's', v => \&_DB__handle_i_command, },
'm' => { t => 's', v => \&_DB__handle_m_command, },
'n' => { t => 'm', v => '_handle_n_command', },
'p' => { t => 'm', v => '_handle_p_command', },
@@ -2551,7 +2583,7 @@ BEGIN
{ 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 v w W)),
+ qw(a A b B e E h l L M o O v w W)),
);
};
@@ -5468,37 +5500,6 @@ sub cmd_h {
}
} ## end sub cmd_h
-=head3 C<cmd_i> - inheritance display
-
-Display the (nested) parentage of the module or object given.
-
-=cut
-
-sub cmd_i {
- my $cmd = shift;
- my $line = shift;
-
- require mro;
-
- foreach my $isa ( split( /\s+/, $line ) ) {
- $evalarg = $isa;
- # The &-call is here to ascertain the mutability of @_.
- ($isa) = &DB::eval;
- no strict 'refs';
- print join(
- ', ',
- map {
- "$_"
- . (
- defined( ${"$_\::VERSION"} )
- ? ' ' . ${"$_\::VERSION"}
- : undef )
- } @{mro::get_linear_isa(ref($isa) || $isa)}
- );
- print "\n";
- }
-} ## end sub cmd_i
-
=head3 C<cmd_l> - list lines (command)
Most of the command is taken up with transforming all the different line