bah, cleanup made it much slower
Yuval Kogman [Sun, 10 Aug 2008 21:36:39 +0000 (21:36 +0000)]
lib/Class/MOP/Package.pm
t/080_meta_package.t

index 1874dea..a712143 100644 (file)
@@ -224,12 +224,16 @@ sub list_all_package_symbols {
     # NOTE:
     # or we can filter based on 
     # type (SCALAR|ARRAY|HASH|CODE)
-    return grep { 
+    if ( $type_filter eq 'CODE' ) {
+        return grep { 
         (ref($namespace->{$_})
-            ? (ref($namespace->{$_}) eq 'SCALAR' && $type_filter eq 'CODE')
-            : (ref(\$namespace->{$_}) eq 'GLOB'
-               && defined(*{$namespace->{$_}}{$type_filter})));
-    } keys %{$namespace};
+                ? (ref($namespace->{$_}) eq 'SCALAR')
+                : (ref(\$namespace->{$_}) eq 'GLOB'
+                   && defined(*{$namespace->{$_}}{CODE})));
+        } keys %{$namespace};
+    } else {
+        return grep { *{$namespace->{$_}}{$type_filter} } keys %{$namespace};
+    }
 }
 
 sub get_all_package_symbols {
@@ -237,33 +241,24 @@ sub get_all_package_symbols {
     my $namespace = $self->namespace;
     return %$namespace unless defined $type_filter;
 
-    my @ret;
-
+    # for some reason this nasty impl is orders of magnitude aster than a clean version
     if ( $type_filter eq 'CODE' ) {
         my $pkg = $self->name;
-        foreach my $key ( keys %$namespace ) {
-            my $value = $namespace->{$key};
-            if ( ref $value ) {
-                no strict 'refs';
-                push @ret, $key => \&{"${pkg}::$key"};
-            } elsif ( ref(\$value) eq 'GLOB' ) {
-                if ( my $ref = *{$value}{CODE} ) {
-                    push @ret, $key, $ref;
-                }
-            }
-        }
+        no strict 'refs';
+        return map {
+            (ref($namespace->{$_})
+                 ? ( $_ => \&{"${pkg}::$_"} )
+                 : ( *{$namespace->{$_}}{CODE}
+                    ? ( $_ => *{$namespace->{$_}}{$type_filter} )
+                    : ()))
+        } keys %$namespace;
     } else {
-        foreach my $key ( keys %$namespace ) {
-            my $value = $namespace->{$key};
-            if ( ref(\$value) eq 'GLOB' ) {
-                if ( my $ref = *{$value}{$type_filter} ) {
-                    push @ret, $key => $ref;
-                }
-            }
-        }
+        return map {
+            $_ => *{$namespace->{$_}}{$type_filter}
+        } grep {
+            !ref($namespace->{$_}) && *{$namespace->{$_}}{$type_filter}
+        } keys %$namespace;
     }
-
-    return @ret;
 }
 
 1;
index 4a6f2f5..3e54a35 100644 (file)
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 92;
+use Test::More tests => 97;
 use Test::Exception;
 
 BEGIN {
@@ -13,6 +13,8 @@ BEGIN {
 
 {
     package Foo;
+
+    use constant SOME_CONSTANT => 1;
     
     sub meta { Class::MOP::Package->initialize('Foo') }
 }
@@ -22,6 +24,7 @@ BEGIN {
 
 ok(!defined($Foo::{foo}), '... the %foo slot has not been created yet');
 ok(!Foo->meta->has_package_symbol('%foo'), '... the meta agrees');
+ok(!defined($Foo::{foo}), '... checking doesn\' vivify');
 
 lives_ok {
     Foo->meta->add_package_symbol('%foo' => { one => 1 });
@@ -252,6 +255,28 @@ is(Foo->meta->get_package_symbol('@foo'), $ARRAY, '... got the right values for
     } 
 }
 
+{
+    Foo->meta->add_package_symbol('%zork');
+
+    my %syms = Foo->meta->get_all_package_symbols('HASH');
+
+    is_deeply(
+        [ sort keys %syms ],
+        [ sort Foo->meta->list_all_package_symbols('HASH') ],
+        '... the fetched symbols are the same as the listed ones'
+    );
+
+    foreach my $symbol (keys %syms) {
+        is($syms{$symbol}, Foo->meta->get_package_symbol('%' . $symbol), '... got the right symbol');
+    }
+
+    no warnings 'once';
+    is_deeply(
+        \%syms,
+        { zork => \%Foo::zork },
+        "got the right ones",
+    );
+}
 # check some errors
 
 dies_ok {