From f3e6b9d3f0dbfe3113fe7639840a85de41c891e6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= Date: Thu, 27 Aug 2020 13:17:02 +0200 Subject: [PATCH] Fix inheritance resolution of lexial objects in a debugger --- ...0-fix-C-i-obj-where-obj-is-a-lexical.patch | 193 ++++++++++++++++++ perl.spec | 12 +- 2 files changed, 204 insertions(+), 1 deletion(-) create mode 100644 perl-5.33.0-fix-C-i-obj-where-obj-is-a-lexical.patch diff --git a/perl-5.33.0-fix-C-i-obj-where-obj-is-a-lexical.patch b/perl-5.33.0-fix-C-i-obj-where-obj-is-a-lexical.patch new file mode 100644 index 0000000..f7acd14 --- /dev/null +++ b/perl-5.33.0-fix-C-i-obj-where-obj-is-a-lexical.patch @@ -0,0 +1,193 @@ +From b334474a337421c6643b872388245fb2c11bf995 Mon Sep 17 00:00:00 2001 +From: Tony Cook +Date: Mon, 30 Mar 2020 16:32:46 +1100 +Subject: [PATCH] fix C 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ř +--- + 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 - 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 - 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 + diff --git a/perl.spec b/perl.spec index df700c2..7cbe905 100644 --- a/perl.spec +++ b/perl.spec @@ -100,7 +100,7 @@ License: GPL+ or Artistic Epoch: %{perl_epoch} Version: %{perl_version} # 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 Url: https://www.perl.org/ 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 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 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) Requires: perl(IO::Socket) Requires: perl(meta_notation) = %{perl_version} +Requires: perl(mro) %if !%{defined perl_bootstrap} Suggests: perl(PadWalker) >= 0.08 %endif @@ -4228,6 +4233,7 @@ you're not running VMS, this module does nothing. %patch27 -p1 %patch28 -p1 %patch29 -p1 +%patch30 -p1 %patch200 -p1 %patch201 -p1 @@ -4264,6 +4270,7 @@ perl -x patchlevel.h \ '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 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 Patch201: Link XS modules to libperl.so with EU::MM on Linux' \ %{nil} @@ -6977,6 +6984,9 @@ popd # Old changelog entries are preserved in CVS. %changelog +* Thu Aug 27 2020 Petr Pisar - 4:5.32.0-462 +- Fix inheritance resolution of lexial objects in a debugger (GH#17661) + * Fri Aug 21 2020 Jeff Law - 4:5.32.0-461 - Re-enable LTO