#!/usr/bin/perl use warnings FATAL => qw( all ); use strict; use Test::More tests => 1; use POSIX qw( _exit ); sub wrap_sigs { my $signals = shift; my $coderef = shift; my $died; my %old_sighandlers; eval { for my $sig (keys %$signals) { $old_sighandlers{$sig} = ($SIG{$sig} || 'DEFAULT'); $SIG{$sig} = sub { die ('SIG' . $sig . "\n") }; } $died = 1 unless eval { $coderef->(); 1 }; for my $sig (keys %old_sighandlers) { $SIG{$sig} = $old_sighandlers{$sig}; } }; return $died; } my $pid = fork; if ($pid) { $SIG{ALRM} = sub { }; my $timeout = time + 5; diag('parent entering wrap_sigs loop'); while (time < $timeout) { wrap_sigs( { ALRM => 1 }, sub { } ); } diag('parent survived, killing child'); kill TERM => $pid; } else { sleep 1; diag('child starting signal storm'); 1 while kill ALRM => getppid; _exit(0); } ok(1, 'survived signal storm');