From: Florian Ragwitz <rafl@debian.org>
Date: Thu, 14 Jan 2010 01:51:59 +0000 (+0100)
Subject: Stop relying on stash entries always being upgraded into real GVs.
X-Git-Tag: 0.12~2
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit%2Fnamespace-clean.git;a=commitdiff_plain;h=226432f602f11579ef0d87d70bbe31547bbd66aa

Stop relying on stash entries always being upgraded into real GVs.
---

diff --git a/Makefile.PL b/Makefile.PL
index db5a201..cf902bb 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -9,7 +9,7 @@ license         q{perl};
 author          q{Robert 'phaylon'' Sedlacek <rs@474.at>};
 all_from        q{lib/namespace/clean.pm};
 
-build_requires  q{Test::More},                  '0.62';
+build_requires  q{Test::More},                  '0.88';
 build_requires  q{FindBin},                     0;
 
 requires        q{B::Hooks::EndOfScope},        '0.07';
diff --git a/lib/namespace/clean.pm b/lib/namespace/clean.pm
index a23e6e9..76bb92e 100644
--- a/lib/namespace/clean.pm
+++ b/lib/namespace/clean.pm
@@ -169,34 +169,44 @@ my $RemoveSubs = sub {
         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;
+        next SYMBOL unless exists ${ "${cleanee}::" }{ $f };
+
+        if (ref(\${ "${cleanee}::" }{ $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.
+            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
+            {   no warnings 'uninitialized';    # fix possible unimports
+                *__tmp = *{ ${ "${cleanee}::" }{ $f } };
+                delete ${ "${cleanee}::" }{ $f };
+            }
+
+          SLOT:
+            # restore non-code slots to symbol.
+            # omit the FORMAT slot, since perl erroneously puts it into the
+            # SCALAR slot of the new glob.
+            for my $t (qw( SCALAR ARRAY HASH IO )) {
+                next SLOT unless defined *__tmp{ $t };
+                *{ "${cleanee}::$f" } = *__tmp{ $t };
+            }
         }
-
-        local *__tmp;
-
-        # keep original value to restore non-code slots
-        {   no warnings 'uninitialized';    # fix possible unimports
-            *__tmp = *{ ${ "${cleanee}::" }{ $f } };
+        else {
+            # A non-glob in the stash is assumed to stand for some kind
+            # of function.  So far they all do, but the core might change
+            # this some day.  Watch perl5-porters.
             delete ${ "${cleanee}::" }{ $f };
         }
-
-      SLOT:
-        # restore non-code slots to symbol.
-        # omit the FORMAT slot, since perl erroneously puts it into the
-        # SCALAR slot of the new glob.
-        for my $t (qw( SCALAR ARRAY HASH IO )) {
-            next SLOT unless defined *__tmp{ $t };
-            *{ "${cleanee}::$f" } = *__tmp{ $t };
-        }
     }
 };
 
diff --git a/t/08-const-sub.t b/t/08-const-sub.t
new file mode 100644
index 0000000..1ec65b9
--- /dev/null
+++ b/t/08-const-sub.t
@@ -0,0 +1,14 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use constant CONST => 123;
+use namespace::clean;
+
+my $x = CONST;
+is $x, 123;
+
+ok eval("!defined(&CONST)");
+
+done_testing;