]> git.vpit.fr Git - perl/modules/IPC-MorseSignals.git/blobdiff - t/lib/IPC/MorseSignals/TestSuite.pm
Importing IPC-MorseSignals-0.13.tar.gz
[perl/modules/IPC-MorseSignals.git] / t / lib / IPC / MorseSignals / TestSuite.pm
index e11025ba1c9ffdd057eccf2a6bffa5190659532c..8e5900d360de6d29fe7685a4c0c60699b9e2debb 100644 (file)
@@ -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;
     }
    }