t/11-ascii.t

   1 #!perl -T
   2
   3 use Test::More tests => 4 * 3;
   4
   5 use POSIX qw/SIGINT SIGTERM SIGKILL SIGHUP EXIT_FAILURE/;
   6
   7 use IPC::MorseSignals qw/msend mrecv mreset/;
   8
   9 my $lives = 5;
  10
  11 sub spawn {
  12  --$lives;
  13  die 'forked too many times' if $lives < 0;
  14  pipe my $rdr, my $wtr or die "pipe() failed: $!";
  15  my $pid = fork;
  16  if (!defined $pid) {
  17   die "fork() failed: $!";
  18  } elsif ($pid == 0) {
  19   close $rdr or die "close() failed: $!";
  20   my $block = 0;
  21   my $s = mrecv local %SIG, cb => sub {
  22    if ($block) {
  23     $block = 0;
  24    } else {
  25     select $wtr; $| = 1;
  26     print $wtr $_[1], "\n";
  27     select $wtr; $| = 1;
  28    }
  29   };
  30   $SIG{HUP} = sub { mreset $s };
  31   $SIG{__WARN__} = sub { $block = 1 };
  32   1 while 1;
  33   exit EXIT_FAILURE;
  34  }
  35  close $wtr or die "close() failed: $!";
  36  return ($pid, $rdr);
  37 }
  38
  39 sub slaughter {
  40  my ($pid) = @_;
  41  kill SIGINT  => $pid;
  42  kill SIGTERM => $pid;
  43  kill SIGKILL => $pid;
  44  waitpid $pid, 0;
  45 }
  46
  47 my ($pid, $rdr) = spawn;
  48
  49 sub trysend {
  50  my ($msg, $desc) = @_;
  51  my $speed = 2 ** 16;
  52  my $ok = 0;
  53  while (!$ok && (($speed /= 2) >= 1)) {
  54   my $r = '';
  55   eval {
  56    local $SIG{ALRM} = sub { die 'timeout' };
  57    local $SIG{__WARN__} = sub { die 'do not want warnings' };
  58    my $a = (int(100 * (3 * length $msg) / $speed) || 1);
  59    $a = 10 if $a > 10;
  60    alarm $a;
  61    kill SIGHUP => $pid;
  62    msend $msg => $pid, speed => $speed, sign => 0;
  63    $r = <$rdr>;
  64   };
  65   kill SIGHUP => $pid if $@;
  66   alarm 0;
  67   if (!defined $r) { # Something bad happened, respawn
  68    close $rdr or die "close() failed: $!";
  69    slaughter $pid;
  70    ($pid, $rdr) = spawn;
  71    $speed *= 2;      # Retry this speed
  72   } else {
  73    chomp $r;
  74    if ($r eq $msg) {
  75     $ok = 1;
  76    } else {
  77     kill SIGHUP => $pid;
  78    }
  79   }
  80  }
  81  ok($ok, $desc);
  82 }
  83
  84 for (1 .. 3) {
  85  trysend 'hello', 'ascii';
  86  trysend "\0" x 10, 'few bits';
  87  trysend "\x{FF}" x 10, 'lots of bits';
  88  trysend "a\0b", 'null character';
  89 }
  90
  91 slaughter $pid;