X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FIPC-MorseSignals.git;a=blobdiff_plain;f=t%2Flib%2FIPC%2FMorseSignals%2FTestSuite.pm;h=8e5900d360de6d29fe7685a4c0c60699b9e2debb;hp=e11025ba1c9ffdd057eccf2a6bffa5190659532c;hb=66395d4fefdc940dce749d571e5c8106f682eca4;hpb=90d2b0db8abb64d3c16d674091938f8c65e9caac diff --git a/t/lib/IPC/MorseSignals/TestSuite.pm b/t/lib/IPC/MorseSignals/TestSuite.pm index e11025b..8e5900d 100644 --- a/t/lib/IPC/MorseSignals/TestSuite.pm +++ b/t/lib/IPC/MorseSignals/TestSuite.pm @@ -4,7 +4,7 @@ use strict; use warnings; use Data::Dumper; -use POSIX qw/pause SIGINT SIGTERM SIGKILL SIGHUP EXIT_FAILURE/; +use POSIX qw/pause SIGUSR1 SIGTSTP SIGKILL EXIT_FAILURE/; use IPC::MorseSignals::Emitter; use IPC::MorseSignals::Receiver; @@ -17,6 +17,9 @@ $Data::Dumper::Indent = 0; my ($lives, $pid, $rdr); +my $ready = 0; +$SIG{USR1} = sub { $ready = 1 }; + sub spawn { --$lives; die 'forked too many times' if $lives < 0; @@ -29,24 +32,30 @@ sub spawn { close $rdr or die "close() failed: $!"; select $wtr; $| = 1; - $SIG{__WARN__} = sub { print $wtr "!warn\n"; }; + my $ppid = getppid; my $rcv = new IPC::MorseSignals::Receiver \%SIG, done => sub { print $wtr Dumper($_[1]), "\n"; + kill SIGUSR1 => $ppid if $ppid; }; - my $ppid = getppid; - $SIG{ALRM} = sub { alarm 1; kill SIGHUP => $ppid }; - alarm 1; - $SIG{HUP} = sub { alarm 0; $rcv->reset }; # We can reset the alarm here. + $SIG{__WARN__} = sub { + my $warn = join '', @_; + $warn =~ s/\n\r/ /g; + print $wtr "!warn : $warn\n"; + kill SIGUSR1 => $ppid if $ppid; + }; + $SIG{TSTP} = sub { + $rcv->reset; + kill SIGUSR1 => $ppid if $ppid; + }; + print $wtr "ok\n"; pause while 1; exit EXIT_FAILURE; } - my $ready = 0; - local $SIG{HUP} = sub { $ready = 1 }; - sleep 1 until $ready; close $wtr or die "close() failed: $!"; my $oldfh = select $rdr; $| = 1; select $oldfh; + my $t = <$rdr>; } sub slaughter { @@ -54,9 +63,7 @@ sub slaughter { close $rdr or die "close() falied: $!"; undef $rdr; } - if (defined $pid) { - kill SIGINT => $pid; - kill SIGTERM => $pid; + if ($pid) { kill SIGKILL => $pid; waitpid $pid, 0; undef $pid; @@ -90,10 +97,11 @@ sub try { my $a = (int(100 * (3 * length $msg) / $speed) || 1); $a = 10 if $a > 10; alarm $a; - kill SIGHUP => $pid; $snd->post($msg); $snd->speed($speed); + $ready = 0; $snd->send($pid); + pause until $ready; $r = <$rdr>; alarm 0; }; @@ -105,7 +113,10 @@ sub try { if ($r eq $dump) { $ok = 1; } else { - kill SIGHUP => $pid; + warn $1 if $r =~ /^warn\s*:\s*(.*)/; + $ready = 0; + kill SIGTSTP => $pid if $pid; + pause until $ready; } } } @@ -133,10 +144,11 @@ TRY: my $a = (int(100 * (3 * $l) / $speed) || 1); $a = 10 if $a > 10; alarm $a; - kill SIGHUP => $pid; $snd->post($msg); $snd->speed($speed); + $ready = 0; $snd->send($pid); + pause until $ready; $r = <$rdr>; alarm 0; }; @@ -149,7 +161,9 @@ TRY: if ($r eq $dump) { ++$ok; } else { - kill SIGHUP => $pid; + $ready = 0; + kill SIGTSTP => $pid if $pid; + pause until $ready; last TRY; } }