From: Graham Knop Date: Tue, 18 Jun 2013 23:12:54 +0000 (-0400) Subject: test and extra cleanups for _concrete_methods_of fix X-Git-Tag: v1.003000~28 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f1ce2b19568463d3f08961bc91d2459b6695bece;p=gitmo%2FRole-Tiny.git test and extra cleanups for _concrete_methods_of fix --- diff --git a/lib/Role/Tiny.pm b/lib/Role/Tiny.pm index b076c8e..f708a16 100644 --- a/lib/Role/Tiny.pm +++ b/lib/Role/Tiny.pm @@ -64,9 +64,9 @@ sub import { }; # grab all *non-constant* (stash slot is not a scalarref) subs present # in the symbol table and store their refaddrs (no need to forcibly - # inflate constant subs into real subs) - also add '' to here (this - # is used later) with a map to the coderefs in case of copying or re-use - my @not_methods = ('', map { *$_{CODE}||() } grep !ref($_), values %$stash); + # inflate constant subs into real subs) with a map to the coderefs in + # case of copying or re-use + my @not_methods = (map { *$_{CODE}||() } grep !ref($_), values %$stash); @{$INFO{$target}{not_methods}={}}{@not_methods} = @not_methods; # a role does itself $APPLIED_TO{$target} = { $target => undef }; @@ -266,8 +266,7 @@ sub _concrete_methods_of { # grab all code entries that aren't in the not_methods list map { my $code = *{$stash->{$_}}{CODE}; - # rely on the '' key we added in import for "no code here" - ( ! $code or exists $not_methods->{$code||''} ) ? () : ($_ => $code) + ( ! $code or exists $not_methods->{$code} ) ? () : ($_ => $code) } grep !ref($stash->{$_}), keys %$stash }; } diff --git a/t/concrete-methods.t b/t/concrete-methods.t new file mode 100644 index 0000000..8425386 --- /dev/null +++ b/t/concrete-methods.t @@ -0,0 +1,32 @@ +use strict; +use warnings FATAL => 'all'; +use Test::More; +use Test::Fatal; + +{ + package MyRole1; + + sub before_role {} + + use Role::Tiny; + + our $GLOBAL1 = 1; + sub after_role {} +} + +{ + package MyClass1; + + our $GLOBAL1 = 1; + sub method {} +} + +my $role_methods = Role::Tiny->_concrete_methods_of('MyRole1'); +is_deeply([sort keys %$role_methods], ['after_role'], + 'only subs after Role::Tiny import are methods' ); + +my $class_methods = Role::Tiny->_concrete_methods_of('MyClass1'); +is_deeply([sort keys %$class_methods], ['method'], + 'only subs from non-Role::Tiny packages are methods' ); + +done_testing;