X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=t%2F12-unicode.t;h=710231127e29ea33e4c5b74f85b10a213c2e8d9f;hb=accfcdfb12dc278650d05fed5f14d78291e66d97;hp=0d3af168fc0a18cbc26d14454405b6f2186f1c7d;hpb=5231a0009f35e98b287dc9633b67bb1de52a23ab;p=perl%2Fmodules%2FIPC-MorseSignals.git diff --git a/t/12-unicode.t b/t/12-unicode.t index 0d3af16..7102311 100644 --- a/t/12-unicode.t +++ b/t/12-unicode.t @@ -1,99 +1,29 @@ #!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; +use lib 't/lib'; +use IPC::MorseSignals::TestSuite qw/try init cleanup/; -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 test { + my ($desc, @args) = @_; + eval { ok(try(@args), $desc) }; + fail($desc . " (died : $@)") if $@; } -sub slaughter { - my ($pid) = @_; - kill SIGINT => $pid; - kill SIGTERM => $pid; - kill SIGKILL => $pid; - waitpid $pid, 0; -} - -my ($pid, $rdr) = spawn; +init 21; -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); -} - -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'; -} +test 'ascii' => 'hello'; +test 'few bits' => "\0" x 5; +test 'lots of bits' => "\x{FF}" x 5; +test 'null character' => "a\0b"; +test 'extended' => 'éàùçà'; +test 'unicode' => '€€€'; +test 'mixed' => 'à€béd'; -slaughter $pid; +cleanup;