t/11-unicode.t

   1 #!perl -T
   2
   3 use Test::More tests => 7 * 5;
   4
   5 use POSIX qw/SIGINT SIGTERM SIGKILL EXIT_SUCCESS EXIT_FAILURE WIFEXITED WEXITSTATUS/;
   6
   7 use IPC::MorseSignals qw/msend mrecv/;
   8
   9 use utf8;
  10
  11 sub trysend8 {
  12  my ($msg, $desc) = @_;
  13  my $speed = 2 ** 16;
  14  my $ok = 0;
  15  $desc .= ' (unicode)';
  16 SPEED:
  17  while ((($speed /= 2) >= 1) && !$ok) {
  18   my $pid = fork;
  19   if (!defined $pid) {
  20    die "$desc: fork() failed : $!";
  21   } elsif ($pid == 0) {
  22    local @SIG{qw/USR1 USR2/} = mrecv sub {
  23     exit(($msg eq $_[0]) ? EXIT_SUCCESS : EXIT_FAILURE);
  24    }, utf8 => 1;
  25    1 while 1;
  26    exit EXIT_FAILURE;
  27   }
  28   my $ret = EXIT_FAILURE;
  29   eval {
  30    local $SIG{ALRM} = sub { die 'timeout' };
  31    my $a = (int(100 * (3 * length $msg) / $speed) || 1);
  32    $a = 10 if $a > 10;
  33    alarm $a;
  34    msend $msg => $pid, speed => $speed, utf8 => 1;
  35    waitpid $pid, 0;
  36    $ok = (WIFEXITED($?) && (WEXITSTATUS($?) == EXIT_SUCCESS));
  37   };
  38   alarm 0;
  39   if ($@) {
  40    kill SIGINT,  $pid;
  41    kill SIGTERM, $pid;
  42    kill SIGKILL, $pid;
  43   }
  44  }
  45  ok($speed >= 1, $desc);
  46 }
  47
  48 for (1 .. 5) {
  49  trysend8 'hello', 'ascii';
  50  trysend8 "\0" x 10, 'few bits';
  51  trysend8 "\x{FF}" x 10, 'lots of bits';
  52  trysend8 "a\0b", 'null character';
  53  trysend8 'éàùçà', 'extended';
  54  trysend8 '€€€', 'unicode';
  55  trysend8 'a€bécàd€e', 'mixed';
  56 }