Importing IPC-MorseSignals-0.14.tar.gz

diff --git a/Changes b/Changes
index 986fd7c5f2bd3d6414690e0375f6a9f87a673017..91a4f2b00e76c4ea8ef52dabf266b3ba4bd27d08 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,14 @@
 Revision history for IPC-MorseSignals
 
 Revision history for IPC-MorseSignals
 

+0.14    2008-03-13
+        + Fix : Correct die error when SIGUSR{1,2} aren't found.
+        + Tst : Don't reset the receiver state, flush the pipe instead.
+                SIGTSTP isn't needed anymore.
+        + Tst : Timeouts aren't truncated to 10 seconds anymore. This used to
+                result into physically logical failures. On the other hand, if
+                the required timeout now goes over 20 seconds, the test is
+                considered failed.
+

 0.13    2008-03-10 15:25 UTC
         + Chg : Build prerequisites are now completely separated from run-time
                 prerequisites.
 0.13    2008-03-10 15:25 UTC
         + Chg : Build prerequisites are now completely separated from run-time
                 prerequisites.

diff --git a/META.yml b/META.yml
index c4bbd9172f1cedc55f0652400d1e1065e23dd5c3..d3ec65b9fce56c33d3ba8a38a19ddc6847f48e0b 100644 (file)
--- a/META.yml
+++ b/META.yml
@@ -1,6 +1,6 @@
 --- #YAML:1.0
 name:                IPC-MorseSignals
 --- #YAML:1.0
 name:                IPC-MorseSignals

-version:             0.13
+version:             0.14

 abstract:            Communicate between processes with Morse signals.
 license:             perl
 author:              
 abstract:            Communicate between processes with Morse signals.
 license:             perl
 author:              


@@ -8,7 +8,7 @@ author:
 generated_by:        ExtUtils::MakeMaker version 6.44
 distribution_type:   module
 requires:     
 generated_by:        ExtUtils::MakeMaker version 6.44
 distribution_type:   module
 requires:     

-    Bit::MorseSignals:             0
+    Bit::MorseSignals:             0.05

     Carp:                          0
     POSIX:                         0
     Time::HiRes:                   0
     Carp:                          0
     POSIX:                         0
     Time::HiRes:                   0

diff --git a/Makefile.PL b/Makefile.PL
index f7ab125617e60c79750de36880f4ec3ee71d6b24..9ee0b24e4280fa3a1988dcda4639e3f1a9bddf19 100644 (file)
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -15,7 +15,7 @@ for (qw/USR1 USR2/) {
  print "Checking if you have SIG$_... ";
  unless (exists $sigs{$_}) {
   print "no\n";
  print "Checking if you have SIG$_... ";
  unless (exists $sigs{$_}) {
   print "no\n";

-  die 'OS unsupported' if $@;
+  die 'OS unsupported';

  }
  print "yes\n";
 }
  }
  print "yes\n";
 }


@@ -48,7 +48,7 @@ WriteMakefile(
     ABSTRACT_FROM       => 'lib/IPC/MorseSignals.pm',
     PL_FILES            => {},
     PREREQ_PM => {
     ABSTRACT_FROM       => 'lib/IPC/MorseSignals.pm',
     PL_FILES            => {},
     PREREQ_PM => {

-        'Bit::MorseSignals' => 0,
+        'Bit::MorseSignals' => 0.05,

         'Carp'              => 0,
         'POSIX'             => 0,
         'Time::HiRes'       => 0,
         'Carp'              => 0,
         'POSIX'             => 0,
         'Time::HiRes'       => 0,

diff --git a/README b/README
index 215ebedcf1e9cd55531fceb9c89c017c45e3d598..119ef391776f22bd9b9f5d20a53144646766fdec 100644 (file)
--- a/README
+++ b/README
@@ -2,7 +2,7 @@ NAME
     IPC::MorseSignals - Communicate between processes with Morse signals.
 
 VERSION
     IPC::MorseSignals - Communicate between processes with Morse signals.
 
 VERSION

-    Version 0.13
+    Version 0.14

 
 SYNOPSIS
         # In the sender process
 
 SYNOPSIS
         # In the sender process

diff --git a/lib/IPC/MorseSignals.pm b/lib/IPC/MorseSignals.pm
index 7cb39284b99102753dcaded98c65bcac9fcebe63..f4e96e82f870e877157ffb10f812d84be8e90615 100644 (file)
--- a/lib/IPC/MorseSignals.pm
+++ b/lib/IPC/MorseSignals.pm
@@ -9,11 +9,11 @@ IPC::MorseSignals - Communicate between processes with Morse signals.
 
 =head1 VERSION
 
 
 =head1 VERSION
 

-Version 0.13
+Version 0.14

 
 =cut
 
 
 =cut
 

-our $VERSION = '0.13';
+our $VERSION = '0.14';

 
 =head1 SYNOPSIS
 
 
 =head1 SYNOPSIS
 

diff --git a/lib/IPC/MorseSignals/Emitter.pm b/lib/IPC/MorseSignals/Emitter.pm
index 940fd16c64e7b09f66b7b02a1a376c7c91257e7f..7e2dca0d27309590eaeba523138f201f7d6846c9 100644 (file)
--- a/lib/IPC/MorseSignals/Emitter.pm
+++ b/lib/IPC/MorseSignals/Emitter.pm
@@ -16,11 +16,11 @@ IPC::MorseSignals::Emitter - Base class for IPC::MorseSignals emitters.
 
 =head1 VERSION
 
 
 =head1 VERSION
 

-Version 0.13
+Version 0.14

 
 =cut
 
 
 =cut
 

-our $VERSION = '0.13';
+our $VERSION = '0.14';

 
 =head1 SYNOPSIS
 
 
 =head1 SYNOPSIS
 

diff --git a/lib/IPC/MorseSignals/Receiver.pm b/lib/IPC/MorseSignals/Receiver.pm
index 44a21b902b4367693e7a9f61482ca98bad9d512a..7bd14163cf74edded74251545ea59dfc16e6aab9 100644 (file)
--- a/lib/IPC/MorseSignals/Receiver.pm
+++ b/lib/IPC/MorseSignals/Receiver.pm
@@ -14,11 +14,11 @@ IPC::MorseSignals::Receiver - Base class for IPC::MorseSignals receivers.
 
 =head1 VERSION
 
 
 =head1 VERSION
 

-Version 0.13
+Version 0.14

 
 =cut
 
 
 =cut
 

-our $VERSION = '0.13';
+our $VERSION = '0.14';

 
 =head1 SYNOPSIS
 
 
 =head1 SYNOPSIS
 

diff --git a/t/60-fork-plain.t b/t/60-fork-plain.t
index a65dde8690b1254e735fc316ea484fdc763d73e8..6d66cf9a58ad2f3c63241615b7e7dbe6c32aeb7e 100644 (file)
--- a/t/60-fork-plain.t
+++ b/t/60-fork-plain.t
@@ -10,8 +10,12 @@ use IPC::MorseSignals::TestSuite qw/try init cleanup/;
 
 sub test {
  my ($desc, @args) = @_;
 
 sub test {
  my ($desc, @args) = @_;

- eval { ok(try(@args), $desc) };
+ my ($res, $speed, $len);
+ eval {
+  ($res, $speed, $len) = try(@args);
+ };

  fail($desc . " (died : $@)") if $@;
  fail($desc . " (died : $@)") if $@;

+ ok($res, $desc . ' (' . $len . ' bits @ ' . $speed . ' bauds)');

 }
 
 my @msgs = qw/hlagh hlaghlaghlagh HLAGH HLAGHLAGHLAGH \x{0dd0}\x{00}
 }
 
 my @msgs = qw/hlagh hlaghlaghlagh HLAGH HLAGHLAGHLAGH \x{0dd0}\x{00}


@@ -19,8 +23,8 @@ my @msgs = qw/hlagh hlaghlaghlagh HLAGH HLAGHLAGHLAGH \x{0dd0}\x{00}
 
 init 6;
 
 
 init 6;
 

-for (0 .. $#msgs) {
- test 'plain ' . $_ => $msgs[$_];
+for (1 .. @msgs) {
+ test 'plain ' . $_ => $msgs[$_-1];

 }
 
 cleanup;
 }
 
 cleanup;

diff --git a/t/61-fork-utf8.t b/t/61-fork-utf8.t
index 29b19105b9411ca9b705ba5a2ca2c843aa7ea26c..038beeada0c8fde8c2d5f6776d10012d881c61e7 100644 (file)
--- a/t/61-fork-utf8.t
+++ b/t/61-fork-utf8.t
@@ -12,16 +12,20 @@ use IPC::MorseSignals::TestSuite qw/try init cleanup/;
 
 sub test {
  my ($desc, @args) = @_;
 
 sub test {
  my ($desc, @args) = @_;

- eval { ok(try(@args), $desc) };
+ my ($res, $speed, $len);
+ eval {
+  ($res, $speed, $len) = try(@args);
+ };

  fail($desc . " (died : $@)") if $@;
  fail($desc . " (died : $@)") if $@;

+ ok($res, $desc . ' (' . $len . ' bits @ ' . $speed . ' bauds)');

 }
 
 my @msgs = qw/€éèë 月語 x tata たTÂ/;
 
 init 6;
 
 }
 
 my @msgs = qw/€éèë 月語 x tata たTÂ/;
 
 init 6;
 

-for (0 .. $#msgs) {
- test 'utf8 ' . $_ => $msgs[$_];
+for (1 .. @msgs) {
+ test 'utf8 ' . $_ => $msgs[$_-1];

 }
 
 cleanup;
 }
 
 cleanup;

diff --git a/t/62-fork-storable.t b/t/62-fork-storable.t
index 6aafeebc053ed8424a083d605dc4ff62c24be70d..9d6f658be57aeb30cea47527f835071c64cd804b 100644 (file)
--- a/t/62-fork-storable.t
+++ b/t/62-fork-storable.t
@@ -12,8 +12,12 @@ use IPC::MorseSignals::TestSuite qw/try init cleanup/;
 
 sub test {
  my ($desc, @args) = @_;
 
 sub test {
  my ($desc, @args) = @_;

- eval { ok(try(@args), $desc) };
+ my ($res, $speed, $len);
+ eval {
+  ($res, $speed, $len) = try(@args);
+ };

  fail($desc . " (died : $@)") if $@;
  fail($desc . " (died : $@)") if $@;

+ ok($res, $desc . ' (' . $len . ' bits @ ' . $speed . ' bauds)');

 }
 
 my @msgs = (
 }
 
 my @msgs = (


@@ -26,8 +30,8 @@ $msgs[7]->{y} = $msgs[7];
 
 init 6;
 
 
 init 6;
 

-for (0 .. $#msgs) {
- test 'storable ' . $_ => $msgs[$_];
+for (1 .. @msgs) {
+ test 'storable ' . $_ => $msgs[$_-1];

 }
 
 cleanup;
 }
 
 cleanup;

diff --git a/t/lib/IPC/MorseSignals/TestSuite.pm b/t/lib/IPC/MorseSignals/TestSuite.pm
index 8e5900d360de6d29fe7685a4c0c60699b9e2debb..8052a8588e3536a866a14a5fde9b946b5d29f558 100644 (file)
--- a/t/lib/IPC/MorseSignals/TestSuite.pm
+++ b/t/lib/IPC/MorseSignals/TestSuite.pm
@@ -4,7 +4,7 @@ use strict;
 use warnings;
 
 use Data::Dumper;
 use warnings;
 
 use Data::Dumper;

-use POSIX qw/pause SIGUSR1 SIGTSTP SIGKILL EXIT_FAILURE/;
+use POSIX qw/pause SIGUSR1 SIGKILL EXIT_FAILURE/;

 
 use IPC::MorseSignals::Emitter;
 use IPC::MorseSignals::Receiver;
 
 use IPC::MorseSignals::Emitter;
 use IPC::MorseSignals::Receiver;


@@ -34,28 +34,26 @@ sub spawn {
   $| = 1;
   my $ppid = getppid;
   my $rcv = new IPC::MorseSignals::Receiver \%SIG, done => sub {
   $| = 1;
   my $ppid = getppid;
   my $rcv = new IPC::MorseSignals::Receiver \%SIG, done => sub {

-   print $wtr Dumper($_[1]), "\n";
+   my $msg = Dumper($_[1]);
+   $msg =~ s/\n\r/ /g;
+   print $wtr "$msg\n";

    kill SIGUSR1 => $ppid if $ppid;
   };
   $SIG{__WARN__} = sub {
    my $warn = join '', @_;
    $warn =~ s/\n\r/ /g;
    kill SIGUSR1 => $ppid if $ppid;
   };
   $SIG{__WARN__} = sub {
    my $warn = join '', @_;
    $warn =~ s/\n\r/ /g;

-   print $wtr "!warn : $warn\n";
+   print $wtr "!warn:$warn\n";

    kill SIGUSR1 => $ppid if $ppid;
   };
    kill SIGUSR1 => $ppid if $ppid;
   };

-  $SIG{TSTP} = sub {
-   $rcv->reset;
-   kill SIGUSR1 => $ppid if $ppid;
-  };
-  print $wtr "ok\n";
+  print $wtr "!ok\n";

   pause while 1;
   exit EXIT_FAILURE;
  }
  close $wtr or die "close() failed: $!";
   pause while 1;
   exit EXIT_FAILURE;
  }
  close $wtr or die "close() failed: $!";

+ my $t = <$rdr>;

  my $oldfh = select $rdr;
  $| = 1;
  select $oldfh;
  my $oldfh = select $rdr;
  $| = 1;
  select $oldfh;

- my $t = <$rdr>;

 }
 
 sub slaughter {
 }
 
 sub slaughter {


@@ -70,6 +68,12 @@ sub slaughter {
  }
 }
 
  }
 }
 

+sub respawn {
+ warn "# respawn ($lives lives left)";
+ slaughter;
+ spawn;
+}
+

 sub init {
  ($lives) = @_;
  $lives ||= 10;
 sub init {
  ($lives) = @_;
  $lives ||= 10;


@@ -85,42 +89,59 @@ my $snd = new IPC::MorseSignals::Emitter;
 sub try {
  my ($msg) = @_;
  my $speed = 2 ** 16;
 sub try {
  my ($msg) = @_;
  my $speed = 2 ** 16;

- my $ok = 0;
- my @ret;
+ my $dump = Dumper($msg);
+ 1 while chomp $dump;
+ $dump =~ s/\n\r/ /g; 
+ $snd->reset;
+ my $len = 0;
+ my $ok  = 0;

  while (!$ok && (($speed /= 2) >= 1)) {
  while (!$ok && (($speed /= 2) >= 1)) {

+  $snd->post($msg);
+  $len = $snd->len;
+  my $a = 1 + (int($len / $speed) || 1);
+  last unless $a <= 20;
+  $snd->speed($speed);

   my $r = '';
   my $r = '';

-  my $dump = Dumper($msg);
-  1 while chomp $dump;

   eval {
    local $SIG{ALRM} = sub { die 'timeout' };
   eval {
    local $SIG{ALRM} = sub { die 'timeout' };

-   local $SIG{__WARN__} = sub { alarm 0; die 'do not want warnings' };
-   my $a = (int(100 * (3 * length $msg) / $speed) || 1);
-   $a = 10 if $a > 10;
+   local $SIG{__WARN__} = sub { $a = alarm 0; die 'do not want warnings' };

    alarm $a;
    alarm $a;

-   $snd->post($msg);
-   $snd->speed($speed);

    $ready = 0;
    $snd->send($pid);
    pause until $ready;
    $r = <$rdr>;
    $ready = 0;
    $snd->send($pid);
    pause until $ready;
    $r = <$rdr>;

-   alarm 0;
+   $a = alarm 0;

   };
   if (!defined $r) { # Something bad happened, respawn
   };
   if (!defined $r) { # Something bad happened, respawn

-   slaughter;
-   spawn;
+   $snd->reset;
+   respawn;

   } else {
    1 while chomp $r;
    if ($r eq $dump) {
     $ok = 1;
    } else {
   } else {
    1 while chomp $r;
    if ($r eq $dump) {
     $ok = 1;
    } else {

-    warn $1 if $r =~ /^warn\s*:\s*(.*)/;
-    $ready = 0;
-    kill SIGTSTP => $pid if $pid;
-    pause until $ready;
+#    warn "# expected $dump, got $r";
+FLUSH:
+    while ($r =~ /^!warn:(.*)/) {
+     warn "# $1";
+     warn "# flushing for $a seconds\n";
+     eval {
+      local $SIG{ALRM} = sub { die 'timeout' };
+      alarm $a;
+      $r = <$rdr>;
+      $a = alarm 0;
+     };
+     if ($@) {
+      $snd->reset;
+      respawn;
+      last FLUSH;
+     }
+    }
+    sleep 1;

    }
   }
  }
    }
   }
  }

- return ($ok) ? $speed : 0;
+ return $ok, $speed, $len;

 }
 
 sub bench {
 }
 
 sub bench {


@@ -130,6 +151,8 @@ sub bench {
  my @alpha = ('a' .. 'z');
  my $msg = join '', map { $alpha[rand @alpha] } 1 .. $l;
  my $dump = Dumper($msg);
  my @alpha = ('a' .. 'z');
  my $msg = join '', map { $alpha[rand @alpha] } 1 .. $l;
  my $dump = Dumper($msg);

+ 1 while chomp $dump;
+ $dump =~ s/\n\r/ /g;

  my $desc_base = "$l bytes sent $n time" . ('s' x ($n != 1));
  while (($ok < $n) && (($speed /= 2) >= 1)) {
   $ok = 0;
  my $desc_base = "$l bytes sent $n time" . ('s' x ($n != 1));
  while (($ok < $n) && (($speed /= 2) >= 1)) {
   $ok = 0;


@@ -137,15 +160,14 @@ sub bench {
   $diag->("try $desc...");
 TRY:
   for (1 .. $n) {
   $diag->("try $desc...");
 TRY:
   for (1 .. $n) {

+   $snd->post($msg);
+   my $a = 1 + (int($snd->len / $speed) || 1);
+   $snd->speed($speed);

    my $r = '';
    eval {
     local $SIG{ALRM} = sub { die 'timeout' };
     local $SIG{__WARN__} = sub { alarm 0; die 'do not want warnings' };
    my $r = '';
    eval {
     local $SIG{ALRM} = sub { die 'timeout' };
     local $SIG{__WARN__} = sub { alarm 0; die 'do not want warnings' };

-    my $a = (int(100 * (3 * $l) / $speed) || 1);
-    $a = 10 if $a > 10;

     alarm $a;
     alarm $a;

-    $snd->post($msg);
-    $snd->speed($speed);

     $ready = 0;
     $snd->send($pid);
     pause until $ready;
     $ready = 0;
     $snd->send($pid);
     pause until $ready;


@@ -153,18 +175,29 @@ TRY:
     alarm 0;
    };
    if (!defined $r) { # Something bad happened, respawn
     alarm 0;
    };
    if (!defined $r) { # Something bad happened, respawn

-    slaughter;
-    spawn;
+    $snd->reset;
+    respawn;

     last TRY;
    } else {
     1 while chomp $r;
     if ($r eq $dump) {
      ++$ok;
     } else {
     last TRY;
    } else {
     1 while chomp $r;
     if ($r eq $dump) {
      ++$ok;
     } else {

-     $ready = 0;
-     kill SIGTSTP => $pid if $pid;
-     pause until $ready;
-     last TRY;
+     while ($r =~ /^!warn:(.*)/) {
+      warn "# $1";
+      warn "# flushing for $a seconds\n";
+      eval {
+       local $SIG{ALRM} = sub { die 'timeout' };
+       alarm $a;
+       $r = <$rdr>;
+       $a = alarm 0;
+      };
+      if ($@) {
+       $snd->reset;
+       respawn;
+       last TRY;
+      }
+     }

     }
    }
   }
     }
    }
   }