From: Yuval Kogman <nothingmuch@woobling.org>
Date: Wed, 23 Sep 2009 15:20:31 +0000 (+0300)
Subject: work around $DB::sub
X-Git-Tag: 0.12~3
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=07fbef3daa75ec3d7339aa3d0daf16dfd46a5a84;p=p5sagit%2Fnamespace-clean.git

work around $DB::sub

The variable is a string which is dereferenced as a sub that no longer
exists.

When we delete the glob where the sub was defined, we therefore alias it
to "namespace::clean::deleted::$fq" so that the debugger can still
dereference a symbolic ref and get back a working subroutine
---

diff --git a/Makefile.PL b/Makefile.PL
index 703dbc4..db5a201 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -14,6 +14,8 @@ build_requires  q{FindBin},                     0;
 
 requires        q{B::Hooks::EndOfScope},        '0.07';
 requires        q{Symbol},                      0;
+requires        q{Sub::Name},                   '0.04';
+requires        q{Sub::Identify},               '0.04';
 
 auto_provides;
 auto_install;
diff --git a/lib/namespace/clean.pm b/lib/namespace/clean.pm
index 1f370fe..a23e6e9 100644
--- a/lib/namespace/clean.pm
+++ b/lib/namespace/clean.pm
@@ -10,8 +10,10 @@ use warnings;
 use strict;
 
 use vars        qw( $VERSION $STORAGE_VAR $SCOPE_HOOK_KEY $SCOPE_EXPLICIT );
-use Symbol      qw( qualify_to_ref );
+use Symbol      qw( qualify_to_ref gensym );
 use B::Hooks::EndOfScope;
+use Sub::Identify qw(sub_fullname);
+use Sub::Name qw(subname);
 
 =head1 VERSION
 
@@ -161,11 +163,24 @@ my $RemoveSubs = sub {
     my $store   = shift;
   SYMBOL:
     for my $f (@_) {
+        my $fq = "${cleanee}::$f";
 
         # ignore already removed symbols
         next SYMBOL if $store->{exclude}{ $f };
         no strict 'refs';
 
+        # 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.
+        my $sub = \&$fq;
+        if ( sub_fullname($sub) eq $fq ) {
+            my $new_fq = "namespace::clean::deleted::$fq";
+            subname($new_fq, $sub);
+            *{$new_fq} = $sub;
+        }
+
         local *__tmp;
 
         # keep original value to restore non-code slots
diff --git a/t/07-debugger.t b/t/07-debugger.t
new file mode 100644
index 0000000..fd4ee87
--- /dev/null
+++ b/t/07-debugger.t
@@ -0,0 +1,34 @@
+#!/usr/bin/perl -d
+
+BEGIN {
+    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);
+    }
+}
+
+use Test::More tests => 5;
+
+ok( !Foo->can("foo"), "foo cleaned up" );
+ok( !Foo->can("baz"), "baz cleaned up" );
+
+Foo->bar();
+
+pass();