Fix RT#83267
Tyler Riddle [Tue, 12 Feb 2013 04:25:06 +0000 (20:25 -0800)]
The following code from Module::Metadata 1.000011 exposed the bug

   BEGIN {
     if ($INC{'Log/Contextual.pm'}) {
       Log::Contextual->import('log_info');
     } else {
       *log_info = sub (&) { warn $_[0]->() };
     }
   }

lib/Log/Contextual.pm
t/regression_83267.t [new file with mode: 0644]

index 4df4f46..a8fcd8d 100644 (file)
@@ -13,6 +13,10 @@ use Exporter::Declare::Export::Generator;
 use Data::Dumper::Concise;
 use Scalar::Util 'blessed';
 
+my @dlog = ((map "Dlog_$_", @levels), (map "DlogS_$_", @levels));
+
+my @log = ((map "log_$_", @levels), (map "logS_$_", @levels));
+
 eval {
    require Log::Log4perl;
    die if $Log::Log4perl::VERSION < 1.29;
@@ -23,7 +27,10 @@ eval {
 # export anything but the levels selected
 sub ____ { }
 
-exports(qw(____ set_logger with_logger ));
+exports ('____',
+   @dlog, @log,
+   qw( set_logger with_logger )
+);
 
 export_tag dlog => ('____');
 export_tag log  => ('____');
diff --git a/t/regression_83267.t b/t/regression_83267.t
new file mode 100644 (file)
index 0000000..3311e89
--- /dev/null
@@ -0,0 +1,44 @@
+use Test::More qw(no_plan);
+
+BEGIN {
+   #an optional expanded test mode
+   if (0) {
+      eval {
+         package NotMain;
+
+         use strict;
+         use warnings;
+         use Test::More;
+         use Log::Contextual::SimpleLogger;
+
+         use Log::Contextual qw(:log),
+           -default_logger =>
+           Log::Contextual::SimpleLogger->new({levels => [qw( )]});
+
+         eval {
+            log_info { "Yep" }
+         };
+         is($@, '', 'Invoked log function in package other than main');
+      };
+
+      is($@, '', 'non-main package subtest did not die');
+   }
+}
+
+package main;
+
+use strict;
+use warnings;
+use Test::More;
+
+#bug report does not include a case where Log::Contextual is
+#brought in via 'use'
+require Log::Contextual;
+
+#try to import a single log function but do not include any tags
+eval { Log::Contextual->import('log_info') };
+is($@, '', 'Imported log function with out dying');
+
+#don't try to invoke the function for now
+#eval { log_info { "test" } 1 };
+#is($@, '', 'Was able to invoke log function');