Fix all debugger issues from perl 5.8.1 on FC++ (RT#69862)

diff --git a/Changes b/Changes
index bc63094..f7cc862 100644 (file)
--- 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 (file)
--- 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 (file)
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 (file)
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;