Bug #38796 for Test-Output: Perl 5.6.2 warn needs a little help capturing message

Apparently Perl 5.6's warn doesn't go through the normal STDERR, so Tie.pm can't capture it without some additional help with a $SIG{__WARN__}. Here's the patch along with the test.

From e98ce4d945bf31b548e841b42b26beb4f11e67d3 Mon Sep 17 00:00:00 2001 From: brian d foy <brian@stonehenge.com> Date: Thu, 28 Aug 2008 09:09:20 -0500 Subject: [PATCH] * Add a test to check that stderr_from can catch output from carp. Apparently, under 5.6, warn does not send its output through STDERR so stderr_from can't capture it. This works fine under 5.8 and later. This is the test showing that it fails, and the next commit should be the fix. --- .gitignore | 4 ++++ MANIFEST | 31 ++++++++++++++++--------------- t/carp-5.6.t | 24 ++++++++++++++++++++++++ 3 files changed, 44 insertions(+), 15 deletions(-) create mode 100644 .gitignore create mode 100644 t/carp-5.6.t diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..985e8ad --- /dev/null +++ b/.gitignore @@ -0,0 +1,4 @@ +*.bak +Makefile +blib +pm_to_blib diff --git a/MANIFEST b/MANIFEST index c5b7ca0..33bc06b 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,26 +1,27 @@ Changes -MANIFEST -META.yml # Will be created by "make dist" -Makefile.PL -README lib/Test/Output.pm lib/Test/Output/Tie.pm +Makefile.PL +MANIFEST +META.yml # Will be created by "make dist" +README t/00.load.t +t/carp-5.6.t +t/combined_is.t +t/combined_isnt.t +t/combined_like.t +t/combined_unlike.t +t/output_is.t +t/output_isnt.t +t/output_like.t +t/output_unlike.t t/pod-coverage.t t/pod.t -t/output_is.t t/stderr_is.t -t/stdout_is.t -t/output_isnt.t t/stderr_isnt.t -t/stdout_isnt.t t/stderr_like.t t/stderr_unlike.t +t/stdout_is.t +t/stdout_isnt.t t/stdout_like.t -t/stdout_unlike.t -t/output_like.t -t/output_unlike.t -t/combined_is.t -t/combined_isnt.t -t/combined_like.t -t/combined_unlike.t +t/stdout_unlike.t \ No newline at end of file diff --git a/t/carp-5.6.t b/t/carp-5.6.t new file mode 100644 index 0000000..4386ef9 --- /dev/null +++ b/t/carp-5.6.t @@ -0,0 +1,24 @@ +use Test::More tests => 3; + +my $class = 'Test::Output'; +my $sub = 'stderr_from'; + +use_ok( $class ); +can_ok( $class, $sub ); + +use Carp qw(carp); + +my $message = "This is from carp"; + +my $output = do { + no strict 'refs'; + &{ "${class}::$sub" }( + sub { carp $message } + ); + }; + +like( + $output, + qr/^\Q$message\E at .* line \d+/, + "stderr_from captures carp message" + ); \ No newline at end of file -- 1.5.4 From 649b3a6832e0efec4ff98b77b1a0b9c324819fa4 Mon Sep 17 00:00:00 2001 From: brian d foy <brian@stonehenge.com> Date: Thu, 28 Aug 2008 09:36:35 -0500 Subject: [PATCH] * Install __WARN__ handler if the Perl version is less than 5.008. This fixes the problem of Perl 5.6's warn bypassing STDERR, which meant that stderr_from couldn't capture it. --- lib/Test/Output.pm | 3 +++ 1 files changed, 3 insertions(+), 0 deletions(-) diff --git a/lib/Test/Output.pm b/lib/Test/Output.pm index f6880a4..646b600 100644 --- a/lib/Test/Output.pm +++ b/lib/Test/Output.pm @@ -842,6 +842,9 @@ stderr_from() executes $coderef and captures STDERR. sub stderr_from (&) { my $test = shift; + local $SIG{__WARN__} = sub { print STDERR @_ } + if $] < 5.008; + select( ( select(STDERR), $| = 1 )[0] ); my $err = tie *STDERR, 'Test::Output::Tie'; -- 1.5.4