1 package IPC::MorseSignals::TestSuite;
7 use POSIX qw/pause SIGKILL EXIT_FAILURE/;
9 use IPC::MorseSignals::Emitter;
10 use IPC::MorseSignals::Receiver;
12 use base qw/Exporter/;
14 our @EXPORT_OK = qw/try bench init cleanup/;
16 $Data::Dumper::Indent = 0;
18 my ($lives, $pid, $rdr);
21 local $SIG{INT} = sub { slaughter };
23 sub diag { warn "# @_" }
27 die 'forked too many times' if $lives < 0;
28 pipe $rdr, my $wtr or die "pipe() failed: $!";
31 die "fork() failed: $!";
34 close $rdr or die "close() failed: $!";
37 my $rcv = IPC::MorseSignals::Receiver->new(\%SIG, done => sub {
38 my $msg = Dumper($_[1]);
42 $SIG{__WARN__} = sub {
43 my $warn = join '', @_;
45 print $wtr "!warn:$warn\n";
51 close $wtr or die "close() failed: $!";
52 my $oldfh = select $rdr;
60 close $rdr or die "close() falied: $!";
67 $kid = waitpid $pid, 0;
68 } while ($kid != $pid && $kid != -1);
74 diag "respawn ($lives lives left)";
87 sub cleanup { slaughter }
89 my $snd = IPC::MorseSignals::Emitter->new;
94 my $dump = Dumper($msg);
99 while (($speed /= 2) >= 1) {
102 my $a = 1 + (int($len / $speed) || 1);
103 last unless $a <= 20;
107 local $SIG{ALRM} = sub { die 'timeout' };
108 local $SIG{__WARN__} = sub { $a = alarm 0; die 'do not want warnings' };
116 return 1, $speed, $len if $r eq $dump;
121 return 0, $speed, $len;
125 my ($l, $n, $res) = @_;
128 my @alpha = ('a' .. 'z');
129 my $msg = join '', map { $alpha[rand @alpha] } 1 .. $l;
130 my $dump = Dumper($msg);
133 my $desc_base = "$l bytes sent $n time" . ('s' x ($n != 1));
134 while (($ok < $n) && (($speed /= 2) >= 1)) {
136 my $desc = "$desc_base at $speed bits/s";
141 my $a = 1 + (int($snd->len / $speed) || 1);
145 local $SIG{ALRM} = sub { die 'timeout' };
146 local $SIG{__WARN__} = sub { alarm 0; die 'do not want warnings' };
164 push @$res, $desc_base . (($speed) ? ' at ' . $speed . ' bits/s' : ' failed');