-sub slaughter {
- my ($pid) = @_;
- kill SIGINT => $pid;
- kill SIGTERM => $pid;
- kill SIGKILL => $pid;
- waitpid $pid, 0;
-}
-
-my ($pid, $rdr) = spawn;
-
-sub trysend {
- my ($msg, $desc) = @_;
- my $speed = 2 ** 16;
- my $ok = 0;
- while (!$ok && (($speed /= 2) >= 1)) {
- my $r = '';
- eval {
- local $SIG{ALRM} = sub { die 'timeout' };
- local $SIG{__WARN__} = sub { die 'do not want warnings' };
- my $a = (int(100 * (3 * length $msg) / $speed) || 1);
- $a = 10 if $a > 10;
- alarm $a;
- kill SIGHUP => $pid;
- msend $msg => $pid, speed => $speed, sign => 0;
- $r = <$rdr>;
- };
- kill SIGHUP => $pid if $@;
- alarm 0;
- if (!defined $r) { # Something bad happened, respawn
- close $rdr or die "close() failed: $!";
- slaughter $pid;
- ($pid, $rdr) = spawn;
- $speed *= 2; # Retry this speed
- } else {
- chomp $r;
- if ($r eq $msg) {
- $ok = 1;
- } else {
- kill SIGHUP => $pid;
- }
- }
- }
- ok($ok, $desc);
-}
-
-for (1 .. 3) {
- trysend 'hello', 'ascii';
- trysend "\0" x 10, 'few bits';
- trysend "\x{FF}" x 10, 'lots of bits';
- trysend "a\0b", 'null character';
-}
-
-slaughter $pid;