]> git.vpit.fr Git - perl/modules/IPC-MorseSignals.git/blob - t/11-ascii.t
53890ccb8a5b8c885e9b5123b29d9fa80442c1f9
[perl/modules/IPC-MorseSignals.git] / 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;