From 0be7ad8f597296b209082a381da610ff2c407a4b Mon Sep 17 00:00:00 2001 From: Graham Knop Date: Tue, 21 Nov 2017 15:29:07 +0100 Subject: [PATCH] don't skip exports that exist in parent class Check the fully qualified sub we are trying to export rather than using can, otherwise we skip exporting subs that exist in the parent class. --- lib/Log/Contextual.pm | 4 +++- t/inherit.t | 33 +++++++++++++++++++++++++++++++++ 2 files changed, 36 insertions(+), 1 deletion(-) create mode 100644 t/inherit.t diff --git a/lib/Log/Contextual.pm b/lib/Log/Contextual.pm index 6af6932..5c3cd57 100644 --- a/lib/Log/Contextual.pm +++ b/lib/Log/Contextual.pm @@ -33,7 +33,9 @@ my @log = ((map "log_$_", @levels), (map "logS_$_", @levels)); sub _maybe_export { my ($spec, $target, $name, $new_code) = @_; - if (my $code = $target->can($name)) { + no strict 'refs'; + if (defined &{"${target}::${name}"}) { + my $code = \&{"${target}::${name}"}; # this will warn $spec->add_export("&$name", $new_code) diff --git a/t/inherit.t b/t/inherit.t new file mode 100644 index 0000000..700b9ba --- /dev/null +++ b/t/inherit.t @@ -0,0 +1,33 @@ +use strict; +use warnings; +use Test::More; +use Test::Fatal; + +use Log::Contextual qw(set_logger); +use Log::Contextual::SimpleLogger; + +BEGIN { + package MySuperClass; + use Log::Contextual qw(:log); +} + +BEGIN { + package MyChildClass; + BEGIN { our @ISA = qw(MySuperClass) }; + use Log::Contextual qw(:log); + + sub do_thing { + log_error { "child class log" }; + } +} + +my $last_log; +set_logger(Log::Contextual::SimpleLogger->new({ + levels => [qw(error)], + coderef => sub { $last_log = shift }, +})); + +is exception { MyChildClass->do_thing; }, undef, + 'log imports work in child class with exports in parent'; + +done_testing;