From a25dd476558dce7d4a98ba4364ffabe54655a9c3 Mon Sep 17 00:00:00 2001 From: cpansprout Date: Mon, 23 Oct 2017 22:19:57 -0700 Subject: [PATCH] Fix to work w/constants (and subrefs in the stash) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This module dies with ‘Not a GLOB reference’ when encountering a scalar reference in a stash, which is how constants have been stored since 5.10 or so, because it assumes that all stash elements contain typeglobs. This commit changes it to account for anything that is not a typeglob already by accessing it via *{$name} syntax. This also makes the module compatible with the CV- in-stash optimization that will likely be in perl 5.28. For details on this optimization, see: https://rt.perl.org/Ticket/Display.html?id=132252#txn-1500037 --- lib/Test/API.pm | 12 ++++++++++-- t/02-public.t | 11 ++++++++++- 2 files changed, 20 insertions(+), 3 deletions(-) diff --git a/lib/Test/API.pm b/lib/Test/API.pm index 1181e57..23443a3 100644 --- a/lib/Test/API.pm +++ b/lib/Test/API.pm @@ -171,9 +171,17 @@ my %private = map { ; $_ => 1 } qw( sub _public_fcns { my ($package) = @_; no strict qw(refs); + my $stash = \%{"$package\::"}; + my @syms; + for (keys %$stash) { + push @syms, + ref \$stash->{$_} eq 'GLOB' + ? \$stash->{$_} + : \*{"$package:\:$_"} + } return grep { substr( $_, 0, 1 ) ne '_' && !$private{$_} && $_ !~ /^\(/ } - map { ( my $f = $_ ) =~ s/^\*$package\:://; $f } - grep { defined( *$_{CODE} ) } values( %{"$package\::"} ); + map { ( my $f = *$_ ) =~ s/^\*$package\:://; $f } + grep { defined( *$_{CODE} ) } @syms; } #--------------------------------------------------------------------------# diff --git a/t/02-public.t b/t/02-public.t index 5448a9b..c0234f7 100644 --- a/t/02-public.t +++ b/t/02-public.t @@ -17,7 +17,7 @@ use Test::More; use Test::Builder::Tester 1.18; use Test::API; -plan tests => 11; +plan tests => 12; require_ok('t::lib::NoSubs'); require_ok('t::lib::SubFoo'); @@ -60,3 +60,12 @@ test_out("ok 1 - public API for t::lib::PvtFoo"); public_ok('t::lib::PvtFoo'); test_test('public_ok - private provided, none expected'); +{ + package PackWithConst; + use constant foo => 1; + $INC{"PackWithConst.pm"}++; +} + +test_out("ok 1 - public API for PackWithConst"); +public_ok("PackWithConst", "foo"); +test_test('public_ok - works with packages containing constants');