From: Peter Rabbitson Date: Wed, 21 Dec 2011 09:37:45 +0000 (+0100) Subject: Fix all debugger issues from perl 5.8.1 on FC++ (RT#69862) X-Git-Tag: 0.22~14 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=80e4e2679ecae28c5a3aeacdd10e5a87d9b0f4b4;p=p5sagit%2Fnamespace-clean.git Fix all debugger issues from perl 5.8.1 on FC++ (RT#69862) --- diff --git a/Changes b/Changes index bc63094..f7cc862 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,5 @@ + - Limit the debugger workarounds to perls between 5.8.8 and 5.14, + extend debugger support to all perl versions (FC) (RT#69862) - Add back dropped NAME section (RT#70259) [0.21] diff --git a/lib/namespace/clean.pm b/lib/namespace/clean.pm index 39f9f22..5e23ab2 100644 --- a/lib/namespace/clean.pm +++ b/lib/namespace/clean.pm @@ -223,27 +223,48 @@ it is your responsibility to make sure it runs at that time. =cut +# Constant to optimise away the unused code branches +use constant RENAME_SUB => $] > 5.008_008_9 && $] < 5.013_006_1; +{ no strict; delete ${__PACKAGE__."::"}{RENAME_SUB} } + +# In perl 5.8.9-5.12, it assumes that sub_fullname($sub) can +# always be used to find the CV again. +# In perl 5.8.8 and 5.14, it assumes that the name of the glob +# passed to entersub can be used to find the CV. +# since we are deleting the glob where the subroutine was originally +# defined, those assumptions no longer hold. +# +# So in 5.8.9-5.12 we need to move it elsewhere and point the +# CV's name to the new glob. +# +# In 5.8.8 and 5.14 we move it elsewhere and rename the +# original glob by assigning the new glob back to it. my $sub_utils_loaded; -my $DebuggerRename = sub { +my $DebuggerFixup = sub { my ($f, $sub, $cleanee_stash, $deleted_stash) = @_; - if (! defined $sub_utils_loaded ) { - $sub_utils_loaded = do { - my $sn_ver = 0.04; - eval { require Sub::Name; Sub::Name->VERSION($sn_ver) } - or die "Sub::Name $sn_ver required when running under -d or equivalent: $@"; + if (RENAME_SUB) { + if (! defined $sub_utils_loaded ) { + $sub_utils_loaded = do { + my $sn_ver = 0.04; + eval { require Sub::Name; Sub::Name->VERSION($sn_ver) } + or die "Sub::Name $sn_ver required when running under -d or equivalent: $@"; - my $si_ver = 0.04; - eval { require Sub::Identify; Sub::Identify->VERSION($si_ver) } - or die "Sub::Identify $si_ver required when running under -d or equivalent: $@"; + my $si_ver = 0.04; + eval { require Sub::Identify; Sub::Identify->VERSION($si_ver) } + or die "Sub::Identify $si_ver required when running under -d or equivalent: $@"; - 1; - } ? 1 : 0; - } + 1; + } ? 1 : 0; + } - if ( Sub::Identify::sub_fullname($sub) eq ($cleanee_stash->name . "::$f") ) { - my $new_fq = $deleted_stash->name . "::$f"; - Sub::Name::subname($new_fq, $sub); + if ( Sub::Identify::sub_fullname($sub) eq ($cleanee_stash->name . "::$f") ) { + my $new_fq = $deleted_stash->name . "::$f"; + Sub::Name::subname($new_fq, $sub); + $deleted_stash->add_symbol("&$f", $sub); + } + } + else { $deleted_stash->add_symbol("&$f", $sub); } }; @@ -263,18 +284,21 @@ my $RemoveSubs = sub { my $sub = $cleanee_stash->get_symbol("&$f") or next SYMBOL; - if ($^P and ref(\$cleanee_stash->namespace->{$f}) eq 'GLOB') { - # convince the Perl debugger to work - # it assumes that sub_fullname($sub) can always be used to find the CV again - # since we are deleting the glob where the subroutine was originally - # defined, that assumption no longer holds, so we need to move it - # elsewhere and point the CV's name to the new glob. - $DebuggerRename->( - $f, - $sub, - $cleanee_stash, - $deleted_stash ||= Package::Stash->new("namespace::clean::deleted::$cleanee"), - ); + my $need_debugger_fixup = + $^P + && + ref(my $globref = \$cleanee_stash->namespace->{$f}) eq 'GLOB' + ; + + if ($need_debugger_fixup) { + # convince the Perl debugger to work + # see the comment on top of $DebuggerFixup + $DebuggerFixup->( + $f, + $sub, + $cleanee_stash, + $deleted_stash ||= Package::Stash->new("namespace::clean::deleted::$cleanee"), + ); } my @symbols = map { @@ -285,6 +309,13 @@ my $RemoveSubs = sub { $cleanee_stash->remove_glob($f); + # if this perl needs no renaming trick we need to + # rename the original glob after the fact + # (see commend of $DebuggerFixup + if (!RENAME_SUB && $need_debugger_fixup) { + *$globref = $deleted_stash->namespace->{$f}; + } + $cleanee_stash->add_symbol(@$_) for @symbols; } }; diff --git a/t/07-debugger.t b/t/07-debugger.t new file mode 100644 index 0000000..decd452 --- /dev/null +++ b/t/07-debugger.t @@ -0,0 +1,34 @@ +use Test::More; + +BEGIN { + $ENV{PERLDB_OPTS} = 'NonStop'; +} + +BEGIN { + +#line 1 +#!/usr/bin/perl -d +#line 10 + +} + +{ + package Foo; + + BEGIN { *baz = sub { 42 } } + sub foo { 22 } + + use namespace::clean; + + sub bar { + ::is(baz(), 42); + ::is(foo(), 22); + } +} + +ok( !Foo->can("foo"), "foo cleaned up" ); +ok( !Foo->can("baz"), "baz cleaned up" ); + +Foo->bar(); + +done_testing; diff --git a/xt/author/07-debugger.t b/xt/author/07-debugger.t deleted file mode 100644 index 7335992..0000000 --- a/xt/author/07-debugger.t +++ /dev/null @@ -1,39 +0,0 @@ -use Test::More; - -BEGIN { - plan skip_all => 'Only applicable on perl >= 5.8.9' - if $] <= 5.008008; - -#line 1 -#!/usr/bin/perl -d -#line 10 - - push @DB::typeahead, "c", "q"; - - # try to shut it up at least a little bit - open my $out, ">", \my $out_buf; - $DB::OUT = $out; - open my $in, "<", \my $in_buf; - $DB::IN = $in; -} - -{ - package Foo; - - BEGIN { *baz = sub { 42 } } - sub foo { 22 } - - use namespace::clean; - - sub bar { - ::is(baz(), 42); - ::is(foo(), 22); - } -} - -ok( !Foo->can("foo"), "foo cleaned up" ); -ok( !Foo->can("baz"), "baz cleaned up" ); - -Foo->bar(); - -done_testing;