X-Git-Url: http://info.iut-bm.univ-fcomte.fr/pub/gitweb/simgrid.git/blobdiff_plain/47d0ea909d927182fc120c9401cd61eeab531972..45b7db0379706165b65554720810d170e828e72f:/tools/tesh/tesh.pl

diff --git a/tools/tesh/tesh.pl b/tools/tesh/tesh.pl
index 6acee9a38d..d67fe47496 100755
--- a/tools/tesh/tesh.pl
+++ b/tools/tesh/tesh.pl
@@ -1,4 +1,4 @@
-#! /usr/bin/perl
+#! /usr/bin/env perl
 
 # Copyright (c) 2012-2014. The SimGrid Team.
 # All rights reserved.
@@ -24,7 +24,6 @@ my($srcdir)=".";
 my($timeout)=0;
 my($time_to_wait)=0;
 my $path = $0;
-my $OS;
 my $enable_coverage=0;
 my $diff_tool=0;
 my $diff_tool_tmp_fh=0;
@@ -46,19 +45,45 @@ use Term::ANSIColor;
 use Text::ParseWords;
 use IPC::Open3;
 use IO::File;
+use English;
 
-if($^O eq "linux"){
-    $OS = "UNIX";
-}
-else{
-    $OS = "WIN";
-    $ENV{"PRINTF_EXPONENT_DIGITS"} = "2";
+## 
+## Portability bits for windows
+##
+
+use constant RUNNING_ON_WINDOWS => ($^O =~ /^(?:mswin|dos|os2)/oi);
+use POSIX qw(:sys_wait_h WIFEXITED WIFSIGNALED WIFSTOPPED WEXITSTATUS WTERMSIG WSTOPSIG
+             :signal_h SIGINT SIGTERM SIGKILL SIGABRT SIGSEGV);
+# These are not implemented on windows (see bug 6798 and 6470)
+BEGIN {
+    if (RUNNING_ON_WINDOWS) {
+	*WIFEXITED   = sub { not $_[0] & 127 };
+	*WEXITSTATUS = sub { $_[0] >> 8 };
+	*WIFSIGNALED = sub { ($_[0] & 127) && ($_[0] & 127 != 127) };
+	*WTERMSIG    = sub { $_[0] & 127 };
+    }
 }
 
+
 ##
 ## Command line option handling
 ##
 
+if ($ARGV[0] eq "--internal-killer-process") {
+    # We fork+exec a waiter process in charge of killing the command after timeout
+    # If the command stops earlier, that's fine: the killer sends a signal to an already stopped process, fails, and quits. 
+    #    Nobody cares about the killer issues. 
+    #    The only problem could arise if another process is given the same PID than cmd. We bet it won't happen :)
+    my $time_to_wait = $ARGV[1];
+    my $pid = $ARGV[2];
+    sleep $time_to_wait;
+    kill('TERM', $pid);
+    sleep 1;
+    kill('KILL', $pid);
+    exit $time_to_wait;
+}
+
+
 sub var_subst {
     my ($text, $name, $value) = @_;
     if ($value) {
@@ -75,23 +100,23 @@ sub var_subst {
 
 # option handling helper subs
 sub cd_cmd {
-  my $directory=$_[1];
-  my $failure=1;
-  if (-e $directory && -d $directory) {
-    chdir("$directory");
-    print "[Tesh/INFO] change directory to $directory\n";
-  $failure=0;
-  } elsif (-e $directory) {
-    print "Cannot change directory to '$directory': it is not a directory\n";
-  } else {
-    print "Chdir to $directory failed: No such file or directory\n";
-  }
-  if($failure==1){
-  $error=1;
-  $exitcode=4;
-  print "Test suite `$tesh_file': NOK (system error)\n";
-  exit 4;
-  }
+    my $directory=$_[1];
+    my $failure=1;
+    if (-e $directory && -d $directory) {
+	chdir("$directory");
+	print "[Tesh/INFO] change directory to $directory\n";
+	$failure=0;
+    } elsif (-e $directory) {
+	print "Cannot change directory to '$directory': it is not a directory\n";
+    } else {
+	print "Chdir to $directory failed: No such file or directory\n";
+    }
+    if($failure==1){
+	$error=1;
+	$exitcode=4;
+	print "Test suite `$tesh_file': NOK (system error)\n";
+	exit 4;
+    }
 }
 
 sub setenv_cmd {
@@ -190,33 +215,25 @@ my($config)="";
 my($tesh_command)=0;
 my(@buffer_tesh)=();
 
-#eval {
-  use POSIX;
+###########################################################################
 
-  sub exit_status {
+sub exit_status {
     my $status = shift;
-    if (POSIX::WIFEXITED($status)) {
-      $exitcode=POSIX::WEXITSTATUS($status)+40;
-      return "returned code ".POSIX::WEXITSTATUS($status);
-    } elsif (POSIX::WIFSIGNALED($status)) {
-      my $code;
-      if (POSIX::WTERMSIG($status) == SIGINT){$code="SIGINT"; }
-      elsif  (POSIX::WTERMSIG($status) == SIGTERM) {$code="SIGTERM"; }
-      elsif  (POSIX::WTERMSIG($status) == SIGKILL) {$code= "SIGKILL"; }
-      elsif  (POSIX::WTERMSIG($status) == SIGABRT) {$code="SIGABRT"; }
-      elsif  (POSIX::WTERMSIG($status) == SIGSEGV) {$code="SIGSEGV" ;}
-      $exitcode=POSIX::WTERMSIG($status)+4;
-      return "got signal $code";
+    if (WIFEXITED($status)) {
+	$exitcode=WEXITSTATUS($status)+40;
+	return "returned code ".WEXITSTATUS($status);
+    } elsif (WIFSIGNALED($status)) {
+	my $code;
+	if (WTERMSIG($status) == SIGINT){$code="SIGINT"; }
+	elsif  (WTERMSIG($status) == SIGTERM) {$code="SIGTERM"; }
+	elsif  (WTERMSIG($status) == SIGKILL) {$code= "SIGKILL"; }
+	elsif  (WTERMSIG($status) == SIGABRT) {$code="SIGABRT"; }
+	elsif  (WTERMSIG($status) == SIGSEGV) {$code="SIGSEGV" ;}
+	$exitcode=WTERMSIG($status)+4;
+	return "got signal $code";
     }
     return "Unparsable status. Is the process stopped?";
-  }
-#};
-#if ($@) { # no POSIX available?
-#  warn "POSIX not usable to parse the return value of forked child: $@\n";
-#  sub exit_status {
-#    return "returned code -1 $@ ";
-#  }
-#}
+}
 
 sub exec_cmd {
   my %cmd = %{$_[0]};
@@ -231,7 +248,7 @@ sub exec_cmd {
   }
 
   # cleanup the command line
-  if($OS eq "WIN") {
+  if(RUNNING_ON_WINDOWS) {
       var_subst($cmd{'cmd'}, "EXEEXT", ".exe");
   } else {
       var_subst($cmd{'cmd'}, "EXEEXT", "");
@@ -273,36 +290,25 @@ sub exec_cmd {
   close CHILD_IN;
 
   # if timeout specified, fork and kill executing child at the end of timeout
-  if (defined($cmd{'timeout'}) or defined($opts{'timeout'})){
+  if (not $cmd{'background'} and (defined($cmd{'timeout'}) or defined($opts{'timeout'}))){
     $time_to_wait= defined($cmd{'timeout'}) ? $cmd{'timeout'} : $opts{'timeout'};
     $forked = fork();
     $timeout=-1;
     die "fork() failed: $!" unless defined $forked;
     if ( $forked == 0 ) { # child
-      sleep $time_to_wait;
-      kill(SIGTERM, $cmd{'pid'});
-      sleep 1;
-      kill(SIGKILL, $cmd{'pid'});
-      exit $time_to_wait;
+	exec("$PROGRAM_NAME --internal-killer-process $time_to_wait $cmd{'pid'}");
     }
   }
 
-
   # Cleanup the executing child, and kill the timeouter brother on need
   $cmd{'return'} = 0 unless defined($cmd{'return'});
-  if($cmd{'background'} != 1){
+  if ($cmd{'background'} != 1) {
     waitpid ($cmd{'pid'}, 0);
     $cmd{'gotret'} = exit_status($?);
     parse_out(\%cmd);
-  }else{
+  } else {
     # & commands, which will be handled at the end
     push @bg_cmds, \%cmd;
-    # no timeout for background commands
-    if($forked){
-       kill(SIGKILL, $forked);
-       $timeout=0;
-       $forked=0;
-    }
   }
 }
 
@@ -365,7 +371,7 @@ sub parse_out {
 
   # Did we timeout ? If yes, handle it. If not, kill the forked process.
 
-  if($timeout==-1 and $gotret eq "got signal SIGKILL"){
+  if($timeout==-1 and ($gotret eq "got signal SIGTERM" or $gotret eq "got signal SIGKILL")){
     $gotret="return code 0";
     $timeout=1;
     $gotret= "timeout after $time_to_wait sec";
@@ -615,7 +621,7 @@ print "hey\n";
     die "[TESH/CRITICAL] parse error: $line\n";
   }
   if($forked){
-   kill(SIGKILL, $forked);
+   kill('KILL', $forked);
    $timeout=0;
   }
 
@@ -631,7 +637,7 @@ if (defined($cmd{'cmd'})) {
 
 
 if($forked){
-   kill(SIGKILL, $forked);
+   kill('KILL', $forked);
    $timeout=0;
 }