From: Graham Knop <haarg@haarg.org>
Date: Wed, 7 Oct 2015 22:49:34 +0000 (-0400)
Subject: Restrict debugger workaround to when DB::sub will be used
X-Git-Tag: 0.27~7
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=aea0cfbed3dc89b308020e9ab4ae93b00579a52b;p=p5sagit%2Fnamespace-clean.git

Restrict debugger workaround to when DB::sub will be used

The issues with the debugger only arise when DB::sub will be called.
Since the workaround requires XS modules, avoid it unless actually
needed.  This avoids XS prereqs when using modules like Devel::Confess
that use debugger features but don't require the workaround.
---

diff --git a/Changes b/Changes
index b456ebc..0ed9350 100644
--- a/Changes
+++ b/Changes
@@ -1,4 +1,6 @@
 
+        - Ensure the debugger workarounds are applied only when
+          DB::sub is actively used (they are superfluous otherwise)
         - Work around P5#72210, resulting in fails on 5.8.8 -Duselongdouble
         - Fix incorrect name in META (RT#107813)
 
diff --git a/lib/namespace/clean.pm b/lib/namespace/clean.pm
index 8d7a56f..80d017a 100644
--- a/lib/namespace/clean.pm
+++ b/lib/namespace/clean.pm
@@ -50,6 +50,13 @@ use namespace::clean::_Util qw( DEBUGGER_NEEDS_CV_RENAME DEBUGGER_NEEDS_CV_PIVOT
 # assumes the name of the glob passed to entersub can be used to find the CV
 # Workaround: realias the original glob to the deleted-stash slot
 #
+# While the errors manifest themselves inside perl5db.pl, they are caused by
+# problems inside the interpreter.  If enabled ($^P & 0x01) and existent,
+# the DB::sub sub will be called by the interpreter for any sub call rather
+# that call the sub directly.  It is provided the real sub to call in $DB::sub,
+# but the value given has the issues described above.  We only have to enable
+# the workaround if DB::sub will be used.
+#
 # Can not tie constants to the current value of $^P directly,
 # as the debugger can be enabled during runtime (kinda dubious)
 #
@@ -72,7 +79,9 @@ my $RemoveSubs = sub {
         my $need_debugger_fixup =
           ( DEBUGGER_NEEDS_CV_RENAME or DEBUGGER_NEEDS_CV_PIVOT )
             &&
-          $^P
+          $^P & 0x01
+            &&
+          defined &DB::sub
             &&
           ref(my $globref = \$cleanee_stash->namespace->{$f}) eq 'GLOB'
             &&
diff --git a/t/07-pseudo-debugger.t b/t/07-pseudo-debugger.t
new file mode 100644
index 0000000..f7020d9
--- /dev/null
+++ b/t/07-pseudo-debugger.t
@@ -0,0 +1,32 @@
+use warnings;
+use strict;
+
+use Test::More tests => 4;
+use lib 't/lib';
+
+BEGIN {
+
+#line 1
+#!/usr/bin/perl -d:_NC_TEST_DashD
+#line 12
+
+}
+
+{
+    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();
diff --git a/t/10-pure-perl.t b/t/10-pure-perl.t
index ed19cf6..744688e 100644
--- a/t/10-pure-perl.t
+++ b/t/10-pure-perl.t
@@ -17,7 +17,7 @@ BEGIN {
 
   $ENV{B_HOOKS_ENDOFSCOPE_IMPLEMENTATION} = 'PP';
   $ENV{PACKAGE_STASH_IMPLEMENTATION} = 'PP';
-  plan tests => 13;
+  plan tests => 14;
 }
 
 use B::Hooks::EndOfScope 0.12;
diff --git a/t/lib/Devel/_NC_TEST_DashD.pm b/t/lib/Devel/_NC_TEST_DashD.pm
new file mode 100644
index 0000000..0a61aca
--- /dev/null
+++ b/t/lib/Devel/_NC_TEST_DashD.pm
@@ -0,0 +1,9 @@
+package Devel::_NC_TEST_DashD;
+
+use warnings;
+use strict;
+
+sub DB::DB { 1 }
+
+1;
+