X-Git-Url: http://info.iut-bm.univ-fcomte.fr/pub/gitweb/simgrid.git/blobdiff_plain/818c1ddfc943e736729794a838d4753a335211b0..4769d8706e26f5ed32cc4c4fad0e2589c795f886:/buildtools/Cmake/Scripts/tesh.pl

diff --git a/buildtools/Cmake/Scripts/tesh.pl b/buildtools/Cmake/Scripts/tesh.pl
index 07e609ee2f..e103a8f5a4 100755
--- a/buildtools/Cmake/Scripts/tesh.pl
+++ b/buildtools/Cmake/Scripts/tesh.pl
@@ -20,10 +20,12 @@ my($time_to_wait)=0;
 my $path = $0;
 my $OS;
 my $enable_coverage=0;
+my $sort_prefix = 19;
 my $tesh_file;
 my $tesh_name;
 my $error=0;
 my $exitcode=0;
+my @bg_cmds;
 
 $path =~ s|[^/]*$||;
 push @INC,$path;
@@ -32,6 +34,7 @@ use Getopt::Long qw(GetOptions);
 use strict;
 use Term::ANSIColor;
 use IPC::Open3;
+use IO::File;
 
 if($^O eq "linux"){
     $OS = "UNIX";
@@ -41,18 +44,6 @@ else{
     $ENV{"PRINTF_EXPONENT_DIGITS"} = "2"; 
 }
 
-
-sub trim($)
-{
-    my $string = shift;
-    $string =~ s/^\s+//;
-    $string =~ s/\s+$//;
-    return $string;
-}
-
-# make sure we received a tesh file
-scalar @ARGV > 0 || die "Usage:\n  tesh [*options*] *tesh_file*\n";
-
 #Add current directory to path
 $ENV{PATH} = "$ENV{PATH}:.";
 
@@ -187,16 +178,17 @@ my(@buffer_tesh)=();
   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";
+      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";
     }
     return "Unparsable status. Is the process stopped?";
   }
@@ -245,10 +237,14 @@ sub exec_cmd {
   ###
   # exec the command line
   ###  $line =~ s/\r//g;
-  $pid = open3(\*CHILD_IN, \*OUT, \*OUT, $cmd{'cmd'} );
+
+  $cmd{'got'} = IO::File->new_tmpfile;
+  $cmd{'got'}->autoflush(1);
+  local *E = $cmd{'got'}; 
+  $cmd{'pid'} = open3(\*CHILD_IN,  ">&E",  ">&E", $cmd{'cmd'} );
 
   # push all provided input to executing child
-  map { print CHILD_IN "$_\n" }  @{$cmd{'in'}};
+  map { print CHILD_IN "$_\n"; }  @{$cmd{'in'}};
   close CHILD_IN;
 
   # if timeout specified, fork and kill executing child at the end of timeout
@@ -259,51 +255,74 @@ sub exec_cmd {
     die "fork() failed: $!" unless defined $forked;
     if ( $forked == 0 ) { # child
       sleep $time_to_wait;
-      kill(SIGKILL, $pid);
+      kill(SIGKILL, $cmd{'pid'});
       exit $time_to_wait;
     }
   }
 
+  
+  # Cleanup the executing child, and kill the timeouter brother on need
+  $cmd{'return'} = 0 unless defined($cmd{'return'});
+  if($cmd{'background'} != 1){
+    waitpid ($cmd{'pid'}, 0);
+    $cmd{'gotret'} = exit_status($?);
+    parse_out(\%cmd);
+  }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;
+    }
+  }
+}
+
+
+sub parse_out { 
+  my %cmd = %{$_[0]};
+  my $gotret=$cmd{'gotret'};
+
+  my $wantret;
+
+  if(defined($cmd{'expect'}) and ($cmd{'expect'} ne "")){
+    $wantret = "got signal $cmd{'expect'}";
+  }else{
+    $wantret = "returned code ".(defined($cmd{'return'})? $cmd{'return'} : 0);
+  }
 
+  local *got = $cmd{'got'};
+  seek(got,0,0);
   # pop all output from executing child
   my @got;
-  while(defined(my $got=<OUT>)) {
+  while(defined(my $got=<got>)) {
     $got =~ s/\r//g;
-    $got =~ s/^( )*//g;
     chomp $got;
-    $got=trim($got);
-    if( $got ne ""){
-        if (!($enable_coverage and $got=~ /^profiling:/)){    
-        push @got, "$got";
-     }
-  }
+    if (!($enable_coverage and $got=~ /^profiling:/)){
+      push @got, $got;
+    }
   }    
-  close OUT;
-   
+
   if ($cmd{'sort'}){   
     sub mysort{
-    $a cmp $b
+        substr($a, 0, $sort_prefix) cmp substr($b, 0, $sort_prefix)
     }
-    use sort qw(defaults _quicksort); # force quicksort
+    use sort 'stable';
     @got = sort mysort @got;
+    while (@got and $got[0] eq "") {
+      shift @got;
+    }
+
     #also resort the other one, as perl sort is not the same as the C one used to generate teshes
     if(defined($cmd{'out'})){
       @{$cmd{'out'}}=sort mysort @{$cmd{'out'}};
+      while (@{$cmd{'out'}} and ${$cmd{'out'}}[0] eq "") {
+        shift @{$cmd{'out'}};
+      }
     }
   }
-  
-  # Cleanup the executing child, and kill the timeouter brother on need
-  $cmd{'return'} = 0 unless defined($cmd{'return'});
-  my $wantret;
-  if(defined($cmd{'expect'}) and ($cmd{'expect'} ne "")){
-    $wantret = "got signal $cmd{'expect'}";
-  }else{
-    $wantret = "returned code ".(defined($cmd{'return'})? $cmd{'return'} : 0);
-    $exitcode= 41;
-  }
-  my $gotret;
-  waitpid ($pid, 0);
-  $gotret = exit_status($?);
+
   #Did we timeout ? If yes, handle it. If not, kill the forked process.
 
   if($timeout==-1 and $gotret eq "got signal SIGKILL"){
@@ -359,7 +378,6 @@ sub mkfile_cmd {
   my $file = $cmd{'arg'};
   print "[Tesh/INFO] mkfile $file\n";
 
-  die "[TESH/CRITICAL] no input provided to mkfile\n" unless defined($cmd{'in'}) && scalar @{$cmd{'in'}};
   unlink($file);
   open(FILE,">$file") or die "[Tesh/CRITICAL] Unable to create file $file: $!\n";
   print FILE join("\n", @{$cmd{'in'}});
@@ -408,8 +426,8 @@ LINE: while (not $finished and not $error) {
   }
 
   # Push delayed commands on empty lines
-  unless ($line =~ m/^(.).(.*)$/) {
-    if (defined($cmd{'cmd'})) {
+  unless ($line =~ m/^(.)(.*)$/) {
+    if (defined($cmd{'cmd'}))  {
       exec_cmd(\%cmd);
       %cmd = ();
     }
@@ -417,16 +435,14 @@ LINE: while (not $finished and not $error) {
   }     
  
   my ($cmd,$arg) = ($1,$2);
+  $arg =~ s/^ //g;
   $arg =~ s/\r//g;
   $arg =~ s/\\\\/\\/g;
   # handle the commands
   if ($cmd =~ /^#/) {    #comment
   } elsif ($cmd eq '>'){    #expected result line
     print "[TESH/debug] push expected result\n" if $opts{'debug'};
-  $arg=trim($arg);
-    if($arg ne ""){
     push @{$cmd{'out'}}, $arg;
-  }
 
   } elsif ($cmd eq '<') {    # provided input
     print "[TESH/debug] push provided input\n" if $opts{'debug'};
@@ -480,6 +496,9 @@ LINE: while (not $finished and not $error) {
       %cmd = ();
     }
     $cmd{'sort'} = 1;
+    if ($line =~ /^!\s*output sort\s+(\d+)/) {
+        $sort_prefix = $1;
+    }
   }
   elsif($line =~ /^!\s*output ignore/){    #output ignore
     if (defined($cmd{'cmd'})) {
@@ -493,6 +512,7 @@ LINE: while (not $finished and not $error) {
       exec_cmd(\%cmd);
       %cmd = ();
     }
+print "hey\n";
     $cmd{'expect'} = "$1";
   }
   elsif($line =~ /^!\s*expect return/){    #expect return
@@ -513,7 +533,7 @@ LINE: while (not $finished and not $error) {
     $line =~ s/\r//g;
     setenv_cmd($line);
   }
-  elsif($line =~ /^!\s*include/){    #output sort
+  elsif($line =~ /^!\s*include/){    #include
     if (defined($cmd{'cmd'})) {
       exec_cmd(\%cmd);
       %cmd = ();
@@ -554,6 +574,16 @@ if($forked){
    $timeout=0;
 }
 
+foreach(@bg_cmds){
+  my %test=%{$_};
+  waitpid ($test{'pid'}, 0);
+  $test{'gotret'} = exit_status($?);
+  parse_out(\%test);
+}
+
+@bg_cmds=();
+
+
 if($error !=0){
     exit $exitcode;
 }elsif($tesh_file eq "(stdin)"){