X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FIPC-MorseSignals.git;a=blobdiff_plain;f=t%2F12-unicode.t;h=77ce70c40782127c3ac3cad68eaeb7960a5ccdb3;hp=0d3af168fc0a18cbc26d14454405b6f2186f1c7d;hb=8a4a3ba553f81cfdb679c19363f514efb04f29c1;hpb=5231a0009f35e98b287dc9633b67bb1de52a23ab diff --git a/t/12-unicode.t b/t/12-unicode.t index 0d3af16..77ce70c 100644 --- a/t/12-unicode.t +++ b/t/12-unicode.t @@ -1,99 +1,23 @@ #!perl -T -use Test::More tests => 7 * 3; +use strict; +use warnings; -use POSIX qw/SIGINT SIGTERM SIGKILL SIGHUP EXIT_FAILURE/; - -use IPC::MorseSignals qw/msend mrecv mreset/; +use Test::More tests => 7; use utf8; -my $lives = 5; - -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: $!"; - binmode $wtr, ':utf8'; - 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: $!"; - binmode $rdr, ':utf8'; - return ($pid, $rdr); -} - -sub slaughter { - my ($pid) = @_; - kill SIGINT => $pid; - kill SIGTERM => $pid; - kill SIGKILL => $pid; - waitpid $pid, 0; -} - -my ($pid, $rdr) = spawn; +use lib 't/lib'; +use IPCMTest qw/try init cleanup/; -sub trysend8 { - my ($msg, $desc) = @_; - my $speed = 2 ** 16; - my $ok = 0; - $desc .= ' (unicode)'; - 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, utf8 => 1, 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); -} +init 1; -for (1 .. 3) { - trysend8 'hello', 'ascii'; - trysend8 "\0" x 10, 'few bits'; - trysend8 "\x{FF}" x 10, 'lots of bits'; - trysend8 "a\0b", 'null character'; - trysend8 'éàùçà', 'extended'; - trysend8 '€€€', 'unicode'; - trysend8 'a€bécàd€e', 'mixed'; -} +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'); +ok(try('éàùçà'), 'extended'); +ok(try('€€€'), 'unicode'); +ok(try('à€béd'), 'mixed'); -slaughter $pid; +cleanup;