t/10-base.t

   1 #!perl -T
   2
   3 use Test::More tests => 7 * 5;
   4
   5 use POSIX qw/SIGINT SIGTERM SIGKILL EXIT_SUCCESS/;
   6
   7 use IPC::MorseSignals qw/msend mrecv/;
   8
   9 sub trysend {
  10  my ($msg, $desc) = @_;
  11  my $speed = 2 ** 16;
  12  my $ok = 0;
  13 SPEED:
  14  while (($speed > 1) && !$ok) {
  15   $speed /= 2;
  16   pipe my $rdr, my $wtr or die "$desc: pipe() failed : $!";
  17   my $pid = fork;
  18   if (!defined $pid) {
  19    die "$desc: fork() failed : $!";
  20   } elsif ($pid == 0) {
  21    close $rdr;
  22    local @SIG{qw/USR1 USR2/} = mrecv sub {
  23     print $wtr $_[0], "\n";
  24     close $wtr;
  25     exit EXIT_SUCCESS;
  26    };
  27    1 while 1;
  28   }
  29   close $wtr or die "$desc: close() failed : $!";
  30   eval {
  31    local $SIG{ALRM} = sub { die 'timeout' };
  32    my $a = (int(100 * (3 * length $msg) / $speed) || 1);
  33    $a = 10 if $a > 10;
  34    alarm $a;
  35    msend $msg => $pid, $speed;
  36    waitpid $pid, 0;
  37   };
  38   alarm 0;
  39   if ($@) {
  40    kill SIGINT,  $pid;
  41    kill SIGTERM, $pid;
  42    kill SIGKILL, $pid;
  43    close $rdr or die "$desc: close() failed : $!";
  44    next SPEED;
  45   }
  46   my $recv = do { local $/; <$rdr> };
  47   close $rdr or die "$desc: close() failed : $!";
  48   next SPEED unless $recv;
  49   chomp $recv;
  50   next SPEED unless $msg eq $recv;
  51   $ok = 1;
  52  }
  53  ok($speed >= 1, $desc);
  54 }
  55
  56 for (1 .. 5) {
  57  trysend 'hello', 'ascii';
  58  trysend 'éàùçà', 'extended';
  59  trysend '€€€', 'unicode';
  60  trysend 'a€bécàd€e', 'mixed';
  61  trysend "\0" x 10, 'few bits';
  62  trysend "\x{FF}" x 10, 'lots of bits';
  63  trysend "a\0b", 'null character';
  64 }