From: Matt S Trout <mst@shadowcat.co.uk>
Date: Mon, 16 Jul 2007 21:05:07 +0000 (+0000)
Subject: undo stevan's broken workarounds, actually fix for 5.9.5
X-Git-Tag: 0_44~16
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=92af7fdfbd3e03c2cbef0bf0513430b53e2c4960;p=gitmo%2FClass-MOP.git

undo stevan's broken workarounds, actually fix for 5.9.5
---

diff --git a/Changes b/Changes
index 095690f..36b672f 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,10 @@
 Revision history for Perl extension Class-MOP.
 
+    * Class::MOP::Package
+      - alter symbol table handling to deal with 5.8.x and 5.9.x
+    * t/
+        Get rid of the crappy workaround from 0.40/41
+
 0.41 Sun. July 15, 2007
     * t/
         Arghh!!! My TODO test didn't work, so I handle
@@ -568,4 +573,4 @@ Revision history for Perl extension Class-MOP.
         - adding POD documentation to the examples
 
 0.01 Thurs Feb. 2, 2006
-    - Initial release
\ No newline at end of file
+    - Initial release
diff --git a/lib/Class/MOP/Package.pm b/lib/Class/MOP/Package.pm
index b0b1b04..a95d29b 100644
--- a/lib/Class/MOP/Package.pm
+++ b/lib/Class/MOP/Package.pm
@@ -124,10 +124,13 @@ sub has_package_symbol {
     # this. Which of course means that 
     # if you put \undef in your scalar
     # then this is broken.
-    
-    if ($type eq 'SCALAR') {    
+
+    if (ref($self->namespace->{$name}) eq 'SCALAR') {
+        return ($type eq 'CODE' ? 1 : 0);
+    }
+    elsif ($type eq 'SCALAR') {    
         my $val = *{$self->namespace->{$name}}{$type};
-        defined(${$val}) ? 1 : 0;        
+        return defined(${$val}) ? 1 : 0;        
     }
     else {
         defined(*{$self->namespace->{$name}}{$type}) ? 1 : 0;
@@ -141,7 +144,19 @@ sub get_package_symbol {
 
     $self->add_package_symbol($variable)
         unless exists $self->namespace->{$name};
-    return *{$self->namespace->{$name}}{$type};
+
+    if (ref($self->namespace->{$name}) eq 'SCALAR') {
+        if ($type eq 'CODE') {
+            no strict 'refs';
+            return \&{$self->name.'::'.$name};
+        }
+        else {
+            return undef;
+        }
+    }
+    else {
+        return *{$self->namespace->{$name}}{$type};
+    }
 }
 
 sub remove_package_symbol {
@@ -194,9 +209,10 @@ sub list_all_package_symbols {
     # type (SCALAR|ARRAY|HASH|CODE)
     my $namespace = $self->namespace;
     return grep { 
-        defined(*{$namespace->{$_}}{$type_filter}) 
-    } grep {
-        ref(\$namespace->{$_}) eq 'GLOB'   
+        (ref($namespace->{$_})
+            ? (ref($namespace->{$_}) eq 'SCALAR' && $type_filter eq 'CODE')
+            : (ref(\$namespace->{$_}) eq 'GLOB'
+               && defined(*{$namespace->{$_}}{$type_filter})));
     } keys %{$namespace};
 }
 
@@ -283,4 +299,4 @@ L<http://www.iinteractive.com>
 This library is free software; you can redistribute it and/or modify
 it under the same terms as Perl itself.
 
-=cut
\ No newline at end of file
+=cut
diff --git a/t/003_methods.t b/t/003_methods.t
index 5406265..9dfcb9e 100644
--- a/t/003_methods.t
+++ b/t/003_methods.t
@@ -84,22 +84,7 @@ is(Foo->foo(), 'Foo::foo', '... Foo->foo() returns "Foo::foo"');
 
 # now check all our other items ...
 
-if ($Foo->has_method('FOO_CONSTANT')) {
-    pass('... Foo->has_method(FOO_CONSTANT) (defined w/ use constant)');
-}
-else {
-    diag(q{
-        FIXME:
-        You are using bleadperl or 5.9.5 which handles constants 
-        in a differnt way then prior versions of perl. This will
-        cause this test to break, but the test it not critical 
-        to the operation of this module, so I am letting pass 
-        with a big FIXME note until I have the tuits to install
-        5.9.5 and fix it. 
-        
-        Of course, patches are *always* welcome :) });    
-    pass('... FIXME: Foo->has_method(FOO_CONSTANT) (defined w/ use constant)');    
-}
+ok($Foo->has_method('FOO_CONSTANT'), '... Foo->has_method(FOO_CONSTANT) (defined w/ use constant)');
 ok($Foo->has_method('bar'), '... Foo->has_method(bar) (defined in Foo)');
 ok($Foo->has_method('baz'), '... Foo->has_method(baz) (typeglob aliased within Foo)');
 ok($Foo->has_method('floob'), '... Foo->has_method(floob) (defined in Foo:: using symbol tables and Sub::Name w/out package name)');