]> git.vpit.fr Git - perl/modules/IPC-MorseSignals.git/commitdiff
Importing IPC-MorseSignals-0.03.tar.gz v0.03
authorVincent Pit <vince@profvince.com>
Sun, 29 Jun 2008 16:35:31 +0000 (18:35 +0200)
committerVincent Pit <vince@profvince.com>
Sun, 29 Jun 2008 16:35:31 +0000 (18:35 +0200)
Changes
META.yml
README
lib/IPC/MorseSignals.pm
samples/bench.pl
t/02-sigusr.t
t/10-base.t
t/11-speed.t

diff --git a/Changes b/Changes
index 14323731f61b6b469abc4ba7f56bc3c138a961d3..b0b881aa25620608500f78a57714744aad93e253 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,8 @@
 Revision history for IPC-MorseSignals
 
+0.03    2007-08-16 16:20 UTC
+        + Chg : Better t/10-base.t... Or at least, I hope so.
+
 0.02    2007-08-16 15:55 UTC
         + Add : samples/bench.pl, a transfer speed benchmark script.
         + Add : New tests : t/02-sigusr.t, t/11-speed.t
index 8a0c77b991898d6b350e52e0149d5b5040bb0306..b7d2982fb8e603a7978a2ea9585385c84f84a002 100644 (file)
--- a/META.yml
+++ b/META.yml
@@ -1,6 +1,6 @@
 --- #YAML:1.0
 name:                IPC-MorseSignals
-version:             0.02
+version:             0.03
 abstract:            Communicate between processes with Morse signals.
 license:             perl
 generated_by:        ExtUtils::MakeMaker version 6.36
diff --git a/README b/README
index 0e5fb787c7941d2347025d6b89e716eaaba89981..32ad19f68369f005a10dcd8dd60e66d0c9b30443 100644 (file)
--- a/README
+++ b/README
@@ -2,7 +2,7 @@ NAME
     IPC::MorseSignals - Communicate between processes with Morse signals.
 
 VERSION
-    Version 0.02
+    Version 0.03
 
 SYNOPSIS
         use IPC::MorseSignals qw/msend mrecv/;
index 214073b59de704de61a88657efb4350cedab3b88..498cd071d2bf5dda3d8ae179428aa83fde3580df 100644 (file)
@@ -12,11 +12,11 @@ IPC::MorseSignals - Communicate between processes with Morse signals.
 
 =head1 VERSION
 
-Version 0.02
+Version 0.03
 
 =cut
 
-our $VERSION = '0.02';
+our $VERSION = '0.03';
 
 =head1 SYNOPSIS
 
index 852c09f283be486f70ed7db1a52145d930d11076..45b485b901706a12db19ad53675077f7bc8ca76f 100755 (executable)
@@ -41,7 +41,7 @@ TRY:
    }
    close $wtr or die "$desc: close() failed : $!";
    eval {
-    local $SIG{ALRM} = sub { die 'alarm' };
+    local $SIG{ALRM} = sub { die 'timeout' };
     my $a = (int(100 * (3 * $l) / $speed) || 1);
     $a = 10 if $a > 10;
     alarm $a;
index 0adb3c681f9622de00a6f8b3545651e0abe64b9f..8a048e9598b90c5302d7fa006c6da248039157c7 100644 (file)
@@ -31,5 +31,6 @@ sub trysig {
  ok($ret == EXIT_SUCCESS, $s);
 }
 
+sleep 1;
 trysig SIGUSR1, 'USR1';
 trysig SIGUSR2, 'USR2';
index 153cffe9d15ae07550ca2f742cd68b8126a36db3..bc55f14925352c77776be4f52e7d44f913e7af7d 100644 (file)
@@ -6,43 +6,51 @@ use POSIX qw/SIGINT SIGTERM SIGKILL EXIT_SUCCESS/;
 
 use IPC::MorseSignals qw/msend mrecv/;
 
-my $speed = 128;
-
 sub trysend {
  my ($msg, $desc) = @_;
- pipe my $rdr, my $wtr or die "$desc: pipe() failed : $!";
- my $pid = fork;
- if (!defined $pid) {
-  die "$desc: fork() failed : $!";
- } elsif ($pid == 0) {
-  close $rdr;
-  local @SIG{qw/USR1 USR2/} = mrecv sub {
-   print $wtr $_[0], "\n";
-   close $wtr;
-   exit EXIT_SUCCESS;
+ my $speed = 2 ** 16;
+ my $ok = 0;
+SPEED:
+ while (($speed > 1) && !$ok) {
+  $speed /= 2;
+  pipe my $rdr, my $wtr or die "$desc: pipe() failed : $!";
+  my $pid = fork;
+  if (!defined $pid) {
+   die "$desc: fork() failed : $!";
+  } elsif ($pid == 0) {
+   close $rdr;
+   local @SIG{qw/USR1 USR2/} = mrecv sub {
+    print $wtr $_[0], "\n";
+    close $wtr;
+    exit EXIT_SUCCESS;
+   };
+   1 while 1;
+  }
+  close $wtr or die "$desc: close() failed : $!";
+  eval {
+   local $SIG{ALRM} = sub { die 'timeout' };
+   my $a = (int(100 * (3 * length $msg) / $speed) || 1);
+   $a = 10 if $a > 10;
+   alarm $a;
+   msend $msg => $pid, $speed;
+   waitpid $pid, 0;
   };
-  1 while 1;
- }
- close $wtr or die "$desc: close() failed : $!";
- eval {
-  local $SIG{ALRM} = sub { die 'timeout' };
-  my $a = (int(100 * (3 * length $msg) / $speed) || 1);
-  $a = 10 if $a > 10;
-  alarm $a;
-  msend $msg => $pid, $speed;
-  waitpid $pid, 0;
- };
- alarm 0;
- if ($@) {
-  kill SIGINT,  $pid;
-  kill SIGTERM, $pid;
-  kill SIGKILL, $pid;
-  die "$desc: died ($@)";
+  alarm 0;
+  if ($@) {
+   kill SIGINT,  $pid;
+   kill SIGTERM, $pid;
+   kill SIGKILL, $pid;
+   close $rdr or die "$desc: close() failed : $!";
+   next SPEED;
+  }
+  my $recv = do { local $/; <$rdr> };
+  close $rdr or die "$desc: close() failed : $!";
+  next SPEED unless $recv;
+  chomp $recv;
+  next SPEED unless $msg eq $recv;
+  $ok = 1;
  }
- my $recv = do { local $/; <$rdr> };
- close $rdr;
- chomp $recv;
- ok($msg eq $recv, $desc);
+ ok($speed >= 1, $desc);
 }
 
 for (1 .. 5) {
index 2593fd4f44341ad2a92c6a93b8edd27dbea46d5b..373bda2729fb4c59aeefcf5c904ef26debecb0d8 100644 (file)
@@ -14,7 +14,7 @@ sub tryspeed {
  my $ok = 0;
  my $msg = join '', map { chr int rand 256 } 1 .. $l;
  my $desc;
- while (($speed >= 1) && ($ok < $n)) {
+ while (($speed > 1) && ($ok < $n)) {
   $desc = "$n sends of $l bytes at $speed bits/s";
   $speed /= 2;
   $ok = 0;
@@ -36,7 +36,7 @@ TRY:
    }
    close $wtr or die "$desc: close() failed : $!";
    eval {
-    local $SIG{ALRM} = sub { die 'alarm' };
+    local $SIG{ALRM} = sub { die 'timeout' };
     my $a = (int(100 * (3 * $l) / $speed) || 1);
     $a = 10 if $a > 10;
     alarm $a;