X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FIPC-MorseSignals.git;a=blobdiff_plain;f=t%2F11-ascii.t;h=b5cc073c012560b3b93afb41041064bfb55b65d7;hp=53890ccb8a5b8c885e9b5123b29d9fa80442c1f9;hb=8a4a3ba553f81cfdb679c19363f514efb04f29c1;hpb=5231a0009f35e98b287dc9633b67bb1de52a23ab diff --git a/t/11-ascii.t b/t/11-ascii.t index 53890cc..b5cc073 100644 --- a/t/11-ascii.t +++ b/t/11-ascii.t @@ -1,91 +1,18 @@ #!perl -T -use Test::More tests => 4 * 3; +use strict; +use warnings; -use POSIX qw/SIGINT SIGTERM SIGKILL SIGHUP EXIT_FAILURE/; +use Test::More tests => 4; -use IPC::MorseSignals qw/msend mrecv mreset/; +use lib 't/lib'; +use IPCMTest qw/try init cleanup/; -my $lives = 5; +init; -sub spawn { - --$lives; - die 'forked too many times' if $lives < 0; - pipe my $rdr, my $wtr or die "pipe() failed: $!"; - my $pid = fork; - if (!defined $pid) { - die "fork() failed: $!"; - } elsif ($pid == 0) { - close $rdr or die "close() failed: $!"; - my $block = 0; - my $s = mrecv local %SIG, cb => sub { - if ($block) { - $block = 0; - } else { - select $wtr; $| = 1; - print $wtr $_[1], "\n"; - select $wtr; $| = 1; - } - }; - $SIG{HUP} = sub { mreset $s }; - $SIG{__WARN__} = sub { $block = 1 }; - 1 while 1; - exit EXIT_FAILURE; - } - close $wtr or die "close() failed: $!"; - return ($pid, $rdr); -} +ok(try('hello'), 'ascii'); +ok(try("\0" x 5), 'few bits'); +ok(try("\x{FF}" x 5), 'lots of bits'); +ok(try("a\0b"), 'null character'); -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; +cleanup;