From: Yuval Kogman Date: Sun, 10 Aug 2008 21:36:39 +0000 (+0000) Subject: bah, cleanup made it much slower X-Git-Tag: 0_64_01~44 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3609af79de2eb5f3f8170965acc899793d861439;p=gitmo%2FClass-MOP.git bah, cleanup made it much slower --- diff --git a/lib/Class/MOP/Package.pm b/lib/Class/MOP/Package.pm index 1874dea..a712143 100644 --- a/lib/Class/MOP/Package.pm +++ b/lib/Class/MOP/Package.pm @@ -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; diff --git a/t/080_meta_package.t b/t/080_meta_package.t index 4a6f2f5..3e54a35 100644 --- a/t/080_meta_package.t +++ b/t/080_meta_package.t @@ -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 {