From: Florian Ragwitz Date: Fri, 5 Dec 2008 06:20:10 +0000 (+0000) Subject: Make get_all_package_symbols return a hashref in scalar context. X-Git-Tag: 0.71_02~11 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6ccb3af555c81195e198f169af6421ef10a4829e;p=gitmo%2FClass-MOP.git Make get_all_package_symbols return a hashref in scalar context. Also deprecate usage in list context with a warning. --- diff --git a/MOP.xs b/MOP.xs index 4499227..bf5b6a4 100644 --- a/MOP.xs +++ b/MOP.xs @@ -329,10 +329,6 @@ get_all_package_symbols(self, filter=TYPE_FILTER_NONE) XSRETURN_EMPTY; } - switch (GIMME_V) { - case G_VOID: return; break; - case G_SCALAR: ST(0) = &PL_sv_undef; return; break; - } PUTBACK; @@ -342,15 +338,31 @@ get_all_package_symbols(self, filter=TYPE_FILTER_NONE) if (!stash) { - XSRETURN_EMPTY; + switch (GIMME_V) { + case G_SCALAR: XSRETURN_UNDEF; break; + case G_ARRAY: XSRETURN_EMPTY; break; + } } symbols = get_all_package_symbols(stash, filter); - EXTEND(SP, HvKEYS(symbols) * 2); - while ((he = hv_iternext(symbols))) { - PUSHs(hv_iterkeysv(he)); - PUSHs(sv_2mortal(SvREFCNT_inc(HeVAL(he)))); + switch (GIMME_V) { + case G_SCALAR: + PUSHs(sv_2mortal(newRV_inc((SV *)symbols))); + break; + case G_ARRAY: + warn("Class::MOP::Package::get_all_package_symbols in list context is deprecated. use scalar context instead."); + + EXTEND(SP, HvKEYS(symbols) * 2); + + while ((he = hv_iternext(symbols))) { + PUSHs(hv_iterkeysv(he)); + PUSHs(sv_2mortal(SvREFCNT_inc(HeVAL(he)))); + } + + break; + default: + break; } SvREFCNT_dec((SV *)symbols); diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm index bc392a6..26c81ad 100644 --- a/lib/Class/MOP/Class.pm +++ b/lib/Class/MOP/Class.pm @@ -330,10 +330,10 @@ sub get_method_map { my $method_metaclass = $self->method_metaclass; - my %all_code = $self->get_all_package_symbols('CODE'); + my $all_code = $self->get_all_package_symbols('CODE'); - foreach my $symbol (keys %all_code) { - my $code = $all_code{$symbol}; + foreach my $symbol (keys %{ $all_code }) { + my $code = $all_code->{$symbol}; next if exists $map->{$symbol} && defined $map->{$symbol} && diff --git a/lib/Class/MOP/Package.pm b/lib/Class/MOP/Package.pm index 96ad798..de1f99d 100644 --- a/lib/Class/MOP/Package.pm +++ b/lib/Class/MOP/Package.pm @@ -283,13 +283,18 @@ sub get_all_package_symbols { my $namespace = $self->namespace; - return %$namespace unless defined $type_filter; + if (wantarray) { + warn 'Class::MOP::Package::get_all_package_symbols in list context is deprecated. use scalar context instead.'; + } + + return (wantarray ? %$namespace : $namespace) unless defined $type_filter; + my %ret; # for some reason this nasty impl is orders of magnitude faster than a clean version if ( $type_filter eq 'CODE' ) { my $pkg; no strict 'refs'; - return map { + %ret = map { (ref($namespace->{$_}) ? ( $_ => \&{$pkg ||= $self->name . "::$_"} ) : ( ref \$namespace->{$_} eq 'GLOB' # don't use {CODE} unless it's really a glob to prevent stringification of stubs @@ -303,12 +308,14 @@ sub get_all_package_symbols { : () }) ) ) } keys %$namespace; } else { - return map { + %ret = map { $_ => *{$namespace->{$_}}{$type_filter} } grep { !ref($namespace->{$_}) && *{$namespace->{$_}}{$type_filter} } keys %$namespace; } + + return wantarray ? %ret : \%ret; } 1; diff --git a/t/080_meta_package.t b/t/080_meta_package.t index 4a8b03e..4ef0554 100644 --- a/t/080_meta_package.t +++ b/t/080_meta_package.t @@ -234,46 +234,46 @@ is(Foo->meta->get_package_symbol('@foo'), $ARRAY, '... got the right values for # get_all_package_symbols { - my %syms = Foo->meta->get_all_package_symbols; + my $syms = Foo->meta->get_all_package_symbols; is_deeply( - [ sort keys %syms ], + [ sort keys %{ $syms } ], [ sort Foo->meta->list_all_package_symbols ], '... the fetched symbols are the same as the listed ones' ); } { - my %syms = Foo->meta->get_all_package_symbols('CODE'); + my $syms = Foo->meta->get_all_package_symbols('CODE'); is_deeply( - [ sort keys %syms ], + [ sort keys %{ $syms } ], [ sort Foo->meta->list_all_package_symbols('CODE') ], '... 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'); + foreach my $symbol (keys %{ $syms }) { + is($syms->{$symbol}, Foo->meta->get_package_symbol('&' . $symbol), '... got the right symbol'); } } { Foo->meta->add_package_symbol('%zork'); - my %syms = Foo->meta->get_all_package_symbols('HASH'); + my $syms = Foo->meta->get_all_package_symbols('HASH'); is_deeply( - [ sort keys %syms ], + [ 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'); + foreach my $symbol (keys %{ $syms }) { + is($syms->{$symbol}, Foo->meta->get_package_symbol('%' . $symbol), '... got the right symbol'); } no warnings 'once'; is_deeply( - \%syms, + $syms, { zork => \%Foo::zork }, "got the right ones", ); diff --git a/t/304_constant_codeinfo.t b/t/304_constant_codeinfo.t index eae71e5..463b4ca 100644 --- a/t/304_constant_codeinfo.t +++ b/t/304_constant_codeinfo.t @@ -13,10 +13,10 @@ use Class::MOP; my $meta = Class::MOP::Class->initialize('Foo'); -my %syms = $meta->get_all_package_symbols('CODE'); -is(ref $syms{FOO}, 'CODE', 'get constant symbol'); +my $syms = $meta->get_all_package_symbols('CODE'); +is(ref $syms->{FOO}, 'CODE', 'get constant symbol'); -undef %syms; +undef $syms; -%syms = $meta->get_all_package_symbols('CODE'); -is(ref $syms{FOO}, 'CODE', 'constant symbol still there, although we dropped our reference'); +$syms = $meta->get_all_package_symbols('CODE'); +is(ref $syms->{FOO}, 'CODE', 'constant symbol still there, although we dropped our reference');