rpms/perl
7
0
Fork 0
Code Issues Pull Requests Releases Activity

Fix inheritance resolution of lexial objects in a debugger

Browse Source
This commit is contained in:
Petr Písař 2020-08-27 13:17:02 +02:00
parent a455b8c3ca
commit f3e6b9d3f0
2 changed files with 204 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

193
perl-5.33.0-fix-C-i-obj-where-obj-is-a-lexical.patch Normal file
View File

@ -0,0 +1,193 @@
From b334474a337421c6643b872388245fb2c11bf995 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 30 Mar 2020 16:32:46 +1100
Subject: [PATCH] fix C<i $obj> where $obj is a lexical
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
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.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
MANIFEST | 1 +
lib/perl5db.pl | 65 +++++++++++++++++++++---------------------
lib/perl5db.t | 20 +++++++++++++
lib/perl5db/t/gh-17661 | 14 +++++++++
4 files changed, 68 insertions(+), 32 deletions(-)
create mode 100644 lib/perl5db/t/gh-17661
diff --git a/MANIFEST b/MANIFEST
index 8c71995174..96af3618bd 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -4808,6 +4808,7 @@ lib/perl5db/t/eval-line-bug Tests for the Perl debugger
lib/perl5db/t/fact Tests for the Perl debugger
lib/perl5db/t/filename-line-breakpoint Tests for the Perl debugger
lib/perl5db/t/gh-17660 Tests for the Perl debugger
+lib/perl5db/t/gh-17661 Tests for the Perl debugger
lib/perl5db/t/load-modules Tests for the Perl debugger
lib/perl5db/t/lsub-n Test script used by perl5db.t
lib/perl5db/t/lvalue-bug Tests for the Perl debugger
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
diff --git a/lib/perl5db.t b/lib/perl5db.t
index 913a301d98..ffa659a215 100644
--- a/lib/perl5db.t
+++ b/lib/perl5db.t
@@ -2946,6 +2946,26 @@ SKIP:
);
}
+{
+ # gh #17661
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'c',
+ 'i $obj',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/gh-17661',
+ }
+ );
+
+ $wrapper->output_like(
+ qr/C5, C1, C2, C3, C4/,
+ q/check for reasonable result/,
+ );
+}
+
SKIP:
{
$Config{usethreads}
diff --git a/lib/perl5db/t/gh-17661 b/lib/perl5db/t/gh-17661
new file mode 100644
index 0000000000..0d85977b35
--- /dev/null
+++ b/lib/perl5db/t/gh-17661
@@ -0,0 +1,14 @@
+use v5.10.0;
+
+{ package C1; sub c1 { } our @ISA = qw(C2) }
+{ package C2; sub c2 { } our @ISA = qw(C3) }
+{ package C3; sub c3 { } our @ISA = qw( ) }
+{ package C4; sub c4 { } our @ISA = qw( ) }
+{ package C5; sub c5 { } our @ISA = qw(C1 C4) }
+
+my $obj = bless {}, 'C5';
+$main::global = bless {}, 'C5';
+
+$DB::single = 1;
+
+say "Done.";
--
2.25.4

12
perl.spec
View File

@ -100,7 +100,7 @@ License: GPL+ or Artistic
Epoch: %{perl_epoch} Epoch: %{perl_epoch}
Version: %{perl_version} Version: %{perl_version}
# release number must be even higher, because dual-lived modules will be broken otherwise # release number must be even higher, because dual-lived modules will be broken otherwise
Release: 461%{?dist} Release: 462%{?dist}
Summary: Practical Extraction and Report Language Summary: Practical Extraction and Report Language
Url: https://www.perl.org/ Url: https://www.perl.org/
Source0: https://www.cpan.org/src/5.0/perl-%{perl_version}.tar.xz Source0: https://www.cpan.org/src/5.0/perl-%{perl_version}.tar.xz
@ -213,6 +213,10 @@ Patch28: perl-5.33.0-XSUB.h-fix-MARK-and-items-variables-inside-BOOT-XSUB
# GH#18019, in upstream after 5.33.0 # GH#18019, in upstream after 5.33.0
Patch29: perl-5.33.0-IO-Handle-Fix-a-spurious-error-reported-for-regular-.patch Patch29: perl-5.33.0-IO-Handle-Fix-a-spurious-error-reported-for-regular-.patch
# Fix inheritance resolution of lexial objects in a debugger, GH#17661,
# in upstream after 5.33.0
Patch30: perl-5.33.0-fix-C-i-obj-where-obj-is-a-lexical.patch
# Link XS modules to libperl.so with EU::CBuilder on Linux, bug #960048 # Link XS modules to libperl.so with EU::CBuilder on Linux, bug #960048
Patch200: perl-5.16.3-Link-XS-modules-to-libperl.so-with-EU-CBuilder-on-Li.patch Patch200: perl-5.16.3-Link-XS-modules-to-libperl.so-with-EU-CBuilder-on-Li.patch
@ -1160,6 +1164,7 @@ Recommends: perl(File::Basename)
Recommends: perl(File::Path) Recommends: perl(File::Path)
Requires: perl(IO::Socket) Requires: perl(IO::Socket)
Requires: perl(meta_notation) = %{perl_version} Requires: perl(meta_notation) = %{perl_version}
Requires: perl(mro)
%if !%{defined perl_bootstrap} %if !%{defined perl_bootstrap}
Suggests: perl(PadWalker) >= 0.08 Suggests: perl(PadWalker) >= 0.08
%endif %endif
@ -4228,6 +4233,7 @@ you're not running VMS, this module does nothing.
%patch27 -p1 %patch27 -p1
%patch28 -p1 %patch28 -p1
%patch29 -p1 %patch29 -p1
%patch30 -p1
%patch200 -p1 %patch200 -p1
%patch201 -p1 %patch201 -p1
@ -4264,6 +4270,7 @@ perl -x patchlevel.h \
'Fedora Patch27: Fix a buffer overread in when reallocating formats (GH#17844)' \ 'Fedora Patch27: Fix a buffer overread in when reallocating formats (GH#17844)' \
'Fedora Patch28: Fix a number of arguments passed to a BOOT XS subroutine (GH#17755)' \ 'Fedora Patch28: Fix a number of arguments passed to a BOOT XS subroutine (GH#17755)' \
'Fedora Patch29: Fix an IO::Handle spurious error reported for regular file handles (GH#18019)' \ 'Fedora Patch29: Fix an IO::Handle spurious error reported for regular file handles (GH#18019)' \
'Fedora Patch30: Fix inheritance resolution of lexial objects in a debugger (GH#17661)' \
'Fedora Patch200: Link XS modules to libperl.so with EU::CBuilder on Linux' \ 'Fedora Patch200: Link XS modules to libperl.so with EU::CBuilder on Linux' \
'Fedora Patch201: Link XS modules to libperl.so with EU::MM on Linux' \ 'Fedora Patch201: Link XS modules to libperl.so with EU::MM on Linux' \
%{nil} %{nil}
@ -6977,6 +6984,9 @@ popd
# Old changelog entries are preserved in CVS. # Old changelog entries are preserved in CVS.
%changelog %changelog
* Thu Aug 27 2020 Petr Pisar <ppisar@redhat.com> - 4:5.32.0-462
- Fix inheritance resolution of lexial objects in a debugger (GH#17661)
* Fri Aug 21 2020 Jeff Law <law@redhat.com> - 4:5.32.0-461 * Fri Aug 21 2020 Jeff Law <law@redhat.com> - 4:5.32.0-461
- Re-enable LTO - Re-enable LTO