Permalink
Browse files

[rt.cpan.org 79886] Fix SIGDIE handler save/restore for Perl 5.8.8.

Applied a modified version of the patch and test case included in the
RT ticket.
  • Loading branch information...
1 parent cb4f65f commit 616bb1050e8f01150c6db1a02570d6dff9c0320c Philip Gwyn committed with Sep 27, 2012
Showing with 126 additions and 7 deletions.
  1. +4 −3 MANIFEST
  2. +8 −4 lib/POE/Kernel.pm
  3. +114 −0 t/90_regression/leolo-sig-die.t
View
@@ -67,14 +67,14 @@ lib/POE/Wheel/ReadWrite.pm
lib/POE/Wheel/Run.pm
lib/POE/Wheel/SocketFactory.pm
mylib/Devel/Null.pm
+mylib/ForkingDaemon.pm
mylib/MyOtherFreezer.pm
mylib/PoeBuildInfo.pm
mylib/coverage.perl
mylib/cpan-test.perl
mylib/events_per_second.pl
mylib/gen-tests.perl
mylib/svn-log.perl
-mylib/ForkingDaemon.pm
t/00_info.t
t/10_units/01_pod/01_pod.t
t/10_units/01_pod/02_pod_coverage.t
@@ -145,6 +145,7 @@ t/90_regression/hinrik-wheel-run-die.t
t/90_regression/kjeldahl-stop-start-polling.t
t/90_regression/kjeldahl-stop-start-sig-nopipe.t
t/90_regression/kjeldahl-stop-start-sig-pipe.t
+t/90_regression/leolo-sig-die.t
t/90_regression/meh-startstop-return.t
t/90_regression/neyuki_detach.t
t/90_regression/rt14444-arg1.t
@@ -154,11 +155,11 @@ t/90_regression/rt23181-sigchld-rc.t
t/90_regression/rt47966-sigchld.t
t/90_regression/rt56417-wheel-run.t
t/90_regression/rt65460-forking.t
+t/90_regression/socketfactory-timeout.t
t/90_regression/somni-poco-server-tcp.t
t/90_regression/steinert-passed-wheel.t
t/90_regression/suzman_windows.t
t/90_regression/ton-stop-corruption.t
+t/90_regression/tracing-sane-exit.t
t/90_regression/whelan-dieprop.t
t/90_regression/whjackson-followtail.t
-t/90_regression/tracing-sane-exit.t
-t/90_regression/socketfactory-timeout.t
View
@@ -855,6 +855,8 @@ sub CLONE {
# Dispatch an event to its session. A lot of work goes on here.
+sub _dummy_sigdie_handler { 1 }
+
sub _dispatch_event {
my (
$self,
@@ -1017,7 +1019,7 @@ sub _dispatch_event {
my $new_sig_die;
if ($type & (ET_CALL | ET_START | ET_STOP)) {
# Don't trigger $SIG{__DIE__} until we're ready to rethrow it.
- local $SIG{__DIE__};
+ local $SIG{__DIE__} = \&_dummy_sigdie_handler;
eval {
if ($wantarray) {
@@ -1039,24 +1041,26 @@ sub _dispatch_event {
}
};
+ # Save the __DIE__ handler so we can check it outside this scope.
$new_sig_die = $SIG{__DIE__};
}
else {
# Don't trigger $SIG{__DIE__} until we're ready to rethrow it.
- local $SIG{__DIE__};
+ local $SIG{__DIE__} = \&_dummy_sigdie_handler;
eval {
$session->_invoke_state(
$source_session, $event, $etc, $file, $line, $fromstate
);
};
+ # Save the __DIE__ handler so we can check it outside this scope.
$new_sig_die = $SIG{__DIE__};
}
# If the user changed $SIG{__DIE__}, then we should honor that.
- # Otherwise, by the time we get here, the last one is restored.
- $SIG{__DIE__} = $new_sig_die if defined $new_sig_die;
+ # Otherwise, by the time we get here, the last one has been restored.
+ $SIG{__DIE__} = $new_sig_die if $new_sig_die ne \&_dummy_sigdie_handler;
# local $@ doesn't work quite the way I expect, but there is a
# bit of a problem if an eval{} occurs here because a signal is
@@ -0,0 +1,114 @@
+#!/usr/bin/perl
+# vim: ts=2 sw=2 filetype=perl expandtab
+
+use warnings;
+use strict;
+
+use Test::More tests => 12;
+
+BEGIN { $ENV{POE_CATCH_EXCEPTIONS} = 0; }
+
+use POE;
+use POE::Session;
+use POE::Kernel;
+
+our $WANT;
+
+sub my_die {
+ my( $err ) = @_;
+ chomp $err;
+ is( $err, $WANT, "error $WANT" );
+ die "$err\nmore\n";
+}
+
+my $poe_dummy_sigdie = \&POE::Kernel::_dummy_sigdie_handler;
+
+POE::Session->create(
+ inline_states => {
+ _start => sub {
+ ok(
+ (
+ not defined $SIG{__DIE__} or
+ $SIG{__DIE__} eq $poe_dummy_sigdie
+ ),
+ '_start'
+ );
+ $poe_kernel->yield( 'step2' );
+ },
+
+ #####
+
+ step2 => sub {
+ # make sure we have a reset __DIE__ in yield
+ ok(
+ (not defined $SIG{__DIE__} or $SIG{__DIE__} eq $poe_dummy_sigdie ),
+ 'step2'
+ );
+ my $ret = $poe_kernel->call( $_[SESSION], 'scalar_ctx' );
+ is( $ret, 42, 'ret' );
+ my @ret = $poe_kernel->call( $_[SESSION], 'array_ctx' );
+ is_deeply( \@ret, [ 1..17 ], 'ret' );
+
+
+ $SIG{__DIE__} = \&my_die;
+ $poe_kernel->post( $_[SESSION], 'step3' );
+ },
+
+ scalar_ctx => sub {
+ # make sure we have a reset __DIE__ in call to scalar context
+ ok(
+ (not defined $SIG{__DIE__} or $SIG{__DIE__} eq $poe_dummy_sigdie ),
+ 'scalar_ctx'
+ );
+ return 42;
+ },
+
+ array_ctx => sub {
+ # make sure we have a reset __DIE__ in call to array context
+ ok(
+ (not defined $SIG{__DIE__} or $SIG{__DIE__} eq $poe_dummy_sigdie ),
+ 'array_ctx'
+ );
+ return ( 1..17 );
+ },
+
+ #####
+
+ step3 => sub {
+ # make sure we have a reset __DIE__ in a post
+ ok(
+ (not defined $SIG{__DIE__} or $SIG{__DIE__} eq $poe_dummy_sigdie ),
+ 'step3'
+ );
+ my $ret = $poe_kernel->call( $_[SESSION], 'scalar_ctx3' );
+ is( $ret, 42, 'ret' );
+ my @ret = $poe_kernel->call( $_[SESSION], 'array_ctx3' );
+ fail( 'we never get here' );
+ },
+
+ scalar_ctx3 => sub {
+ # make sure we have a reset __DIE__ even if we set one
+ ok(
+ (not defined $SIG{__DIE__} or $SIG{__DIE__} eq $poe_dummy_sigdie ),
+ 'scalar_ctx3'
+ );
+ return 42;
+ },
+
+ array_ctx3 => sub {
+ # now we throw an execption up to our __DIE__ handler
+ ok(
+ (not defined $SIG{__DIE__} or $SIG{__DIE__} eq $poe_dummy_sigdie ),
+ 'array_ctx'
+ );
+ $WANT = "array_ctx3";
+ die "$WANT\n";
+ return ( 1..17 );
+ },
+ }
+);
+
+eval { $poe_kernel->run };
+
+# make sure we caught the execption thrown in array_ctx3
+is($@, "array_ctx3\nmore\n", 'exited');

0 comments on commit 616bb10

Please sign in to comment.