use warnings;
use Data::Dumper;
-use POSIX qw/pause SIGUSR1 SIGTSTP SIGKILL EXIT_FAILURE/;
+use POSIX qw/pause SIGUSR1 SIGKILL EXIT_FAILURE/;
use IPC::MorseSignals::Emitter;
use IPC::MorseSignals::Receiver;
$| = 1;
my $ppid = getppid;
my $rcv = new IPC::MorseSignals::Receiver \%SIG, done => sub {
- print $wtr Dumper($_[1]), "\n";
+ my $msg = Dumper($_[1]);
+ $msg =~ s/\n\r/ /g;
+ print $wtr "$msg\n";
kill SIGUSR1 => $ppid if $ppid;
};
$SIG{__WARN__} = sub {
my $warn = join '', @_;
$warn =~ s/\n\r/ /g;
- print $wtr "!warn : $warn\n";
+ print $wtr "!warn:$warn\n";
kill SIGUSR1 => $ppid if $ppid;
};
- $SIG{TSTP} = sub {
- $rcv->reset;
- kill SIGUSR1 => $ppid if $ppid;
- };
- print $wtr "ok\n";
+ print $wtr "!ok\n";
pause while 1;
exit EXIT_FAILURE;
}
close $wtr or die "close() failed: $!";
+ my $t = <$rdr>;
my $oldfh = select $rdr;
$| = 1;
select $oldfh;
- my $t = <$rdr>;
}
sub slaughter {
}
}
+sub respawn {
+ warn "# respawn ($lives lives left)";
+ slaughter;
+ spawn;
+}
+
sub init {
($lives) = @_;
$lives ||= 10;
sub try {
my ($msg) = @_;
my $speed = 2 ** 16;
- my $ok = 0;
- my @ret;
+ my $dump = Dumper($msg);
+ 1 while chomp $dump;
+ $dump =~ s/\n\r/ /g;
+ $snd->reset;
+ my $len = 0;
+ my $ok = 0;
while (!$ok && (($speed /= 2) >= 1)) {
+ $snd->post($msg);
+ $len = $snd->len;
+ my $a = 1 + (int($len / $speed) || 1);
+ last unless $a <= 20;
+ $snd->speed($speed);
my $r = '';
- my $dump = Dumper($msg);
- 1 while chomp $dump;
eval {
local $SIG{ALRM} = sub { die 'timeout' };
- local $SIG{__WARN__} = sub { alarm 0; die 'do not want warnings' };
- my $a = (int(100 * (3 * length $msg) / $speed) || 1);
- $a = 10 if $a > 10;
+ local $SIG{__WARN__} = sub { $a = alarm 0; die 'do not want warnings' };
alarm $a;
- $snd->post($msg);
- $snd->speed($speed);
$ready = 0;
$snd->send($pid);
pause until $ready;
$r = <$rdr>;
- alarm 0;
+ $a = alarm 0;
};
if (!defined $r) { # Something bad happened, respawn
- slaughter;
- spawn;
+ $snd->reset;
+ respawn;
} else {
1 while chomp $r;
if ($r eq $dump) {
$ok = 1;
} else {
- warn $1 if $r =~ /^warn\s*:\s*(.*)/;
- $ready = 0;
- kill SIGTSTP => $pid if $pid;
- pause until $ready;
+# warn "# expected $dump, got $r";
+FLUSH:
+ while ($r =~ /^!warn:(.*)/) {
+ warn "# $1";
+ warn "# flushing for $a seconds\n";
+ eval {
+ local $SIG{ALRM} = sub { die 'timeout' };
+ alarm $a;
+ $r = <$rdr>;
+ $a = alarm 0;
+ };
+ if ($@) {
+ $snd->reset;
+ respawn;
+ last FLUSH;
+ }
+ }
+ sleep 1;
}
}
}
- return ($ok) ? $speed : 0;
+ return $ok, $speed, $len;
}
sub bench {
my @alpha = ('a' .. 'z');
my $msg = join '', map { $alpha[rand @alpha] } 1 .. $l;
my $dump = Dumper($msg);
+ 1 while chomp $dump;
+ $dump =~ s/\n\r/ /g;
my $desc_base = "$l bytes sent $n time" . ('s' x ($n != 1));
while (($ok < $n) && (($speed /= 2) >= 1)) {
$ok = 0;
$diag->("try $desc...");
TRY:
for (1 .. $n) {
+ $snd->post($msg);
+ my $a = 1 + (int($snd->len / $speed) || 1);
+ $snd->speed($speed);
my $r = '';
eval {
local $SIG{ALRM} = sub { die 'timeout' };
local $SIG{__WARN__} = sub { alarm 0; die 'do not want warnings' };
- my $a = (int(100 * (3 * $l) / $speed) || 1);
- $a = 10 if $a > 10;
alarm $a;
- $snd->post($msg);
- $snd->speed($speed);
$ready = 0;
$snd->send($pid);
pause until $ready;
alarm 0;
};
if (!defined $r) { # Something bad happened, respawn
- slaughter;
- spawn;
+ $snd->reset;
+ respawn;
last TRY;
} else {
1 while chomp $r;
if ($r eq $dump) {
++$ok;
} else {
- $ready = 0;
- kill SIGTSTP => $pid if $pid;
- pause until $ready;
- last TRY;
+ while ($r =~ /^!warn:(.*)/) {
+ warn "# $1";
+ warn "# flushing for $a seconds\n";
+ eval {
+ local $SIG{ALRM} = sub { die 'timeout' };
+ alarm $a;
+ $r = <$rdr>;
+ $a = alarm 0;
+ };
+ if ($@) {
+ $snd->reset;
+ respawn;
+ last TRY;
+ }
+ }
}
}
}