X-Git-Url: http://info.iut-bm.univ-fcomte.fr/pub/gitweb/simgrid.git/blobdiff_plain/67c91d5b8652b0e76801e9cfc7d965a360237152..2bd9a37bbb72eac4ed613b3d6953aba6555e2e92:/buildtools/Cmake/Scripts/tesh.pl

diff --git a/buildtools/Cmake/Scripts/tesh.pl b/buildtools/Cmake/Scripts/tesh.pl
index 31acb42b13..9f218e9101 100755
--- a/buildtools/Cmake/Scripts/tesh.pl
+++ b/buildtools/Cmake/Scripts/tesh.pl
@@ -1,4 +1,10 @@
 #! /usr/bin/perl
+
+# Copyright (c) 2012-2014. The SimGrid Team.
+# All rights reserved.
+
+# This program is free software; you can redistribute it and/or modify it
+# under the terms of the license (GNU LGPL) which comes with this package.
 eval 'exec perl -S $0 ${1+"$@"}'
   if $running_under_some_shell;
 
@@ -20,45 +26,53 @@ my($time_to_wait)=0;
 my $path = $0;
 my $OS;
 my $enable_coverage=0;
+my $diff_tool=0;
+my $diff_tool_tmp_fh=0;
+my $diff_tool_tmp_filename=0;
+my $sort_prefix = 19;
 my $tesh_file;
 my $tesh_name;
 my $error=0;
 my $exitcode=0;
-
+my @bg_cmds;
+my (%environ);
+$SIG{'PIPE'} = 'IGNORE';
 $path =~ s|[^/]*$||;
 push @INC,$path;
 
 use Getopt::Long qw(GetOptions);
 use strict;
 use Term::ANSIColor;
+use Text::ParseWords;
 use IPC::Open3;
+use IO::File;
 
 if($^O eq "linux"){
     $OS = "UNIX";
 }
 else{
     $OS = "WIN";
+    $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}:.";
-
 ##
 ## Command line option handling
 ##
 
+sub var_subst {
+    my ($text, $name, $value) = @_;
+    if ($value) {
+        $text =~ s/\${$name(?::[=-][^}]*)?}/$value/g;
+        $text =~ s/\$$name(\W|$)/$value$1/g;
+    }
+    else {
+        $text =~ s/\${$name:=([^}]*)}/$1/g;
+        $text =~ s/\${$name}//g;
+        $text =~ s/\$$name(\W|$)/$1/g;
+    }
+    return $text;
+}
+
 # option handling helper subs
 sub cd_cmd {
   my $directory=$_[1];
@@ -86,24 +100,12 @@ sub setenv_cmd {
     ($var,$ctn)=($1,$2);
   }elsif ($_[1] =~ /^(.*)=(.*)$/) {
     ($var,$ctn)=($1,$2);
-  } else { 
+  } else {
       die "[Tesh/CRITICAL] Malformed argument to setenv: expected 'name=value' but got '$_[1]'\n";
   }
-    
-    if($var =~ /bindir/){
-        print "[Tesh/INFO] setenv $var=$ctn\n";
-        $bindir = $ctn;
-    }
-    else
-    {
-        if($var =~ /srcdir/){
-            $srcdir = $ctn;
-        }
-        else{
-            $ENV{$var} = $ctn;
-            print "[Tesh/INFO] setenv $var=$ctn\n";
-        }
-    }    
+
+  print "[Tesh/INFO] setenv $var=$ctn\n";
+  $environ{$var} = $ctn;
 }
 
 # Main option parsing sub
@@ -126,25 +128,33 @@ sub get_options {
     );
 
   Getopt::Long::config('bundling', 'no_getopt_compat', 'no_auto_abbrev');
-  
+
   GetOptions(
     'help|h'   => \$opt{'help'},
 
     'verbose|v'  => \@verbose,
     'debug|d'  => \$opt{"debug"},
 
+    'difftool=s' => \$diff_tool,
+
     'cd=s'     => \&cd_cmd,
-    'timeout=s'  => \$opt{'timeout'},    
+    'timeout=s'  => \$opt{'timeout'},
     'setenv=s'   => \&setenv_cmd,
     'cfg=s'    => \@cfg,
     'log=s'    => \$log,
-    'enable-coverage+'  => \$enable_coverage,    
+    'enable-coverage+'  => \$enable_coverage,
     );
 
   if($enable_coverage){
     print "Enable coverage\n";
   }
 
+  if($diff_tool){
+    use File::Temp qw/ tempfile /;
+    ($diff_tool_tmp_fh, $diff_tool_tmp_filename) = tempfile();
+    print "New tesh: $diff_tool_tmp_filename\n";
+  }
+
   unless($tesh_file=~/(.*)\.tesh/){
     $tesh_file="(stdin)";
     $tesh_name="(stdin)";
@@ -186,16 +196,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?";
   }
@@ -207,7 +218,7 @@ my(@buffer_tesh)=();
 #  }
 #}
 
-sub exec_cmd { 
+sub exec_cmd {
   my %cmd = %{$_[0]};
   if ($opts{'debug'}) {
     print "IN BEGIN\n";
@@ -220,34 +231,45 @@ sub exec_cmd {
   }
 
   # cleanup the command line
-  if($OS eq "WIN"){
-        $cmd{'cmd'} =~ s/\${EXEEXT:=}/.exe/g;
-        $cmd{'cmd'} =~ s/\${EXEEXT}/.exe/g;
-        $cmd{'cmd'} =~ s/\$EXEEXT/.exe/g;
-    }
-    else{
-        $cmd{'cmd'} =~ s/\${EXEEXT:=}//g;
-    }
-  $cmd{'cmd'} =~ s/\${bindir:=}/$bindir/g;
-  $cmd{'cmd'} =~ s/\${srcdir:=}/$srcdir/g;
-  $cmd{'cmd'} =~ s/\${bindir:=.}/$bindir/g;
-  $cmd{'cmd'} =~ s/\${srcdir:=.}/$srcdir/g;
-  $cmd{'cmd'} =~ s/\${bindir}/$bindir/g;
-  $cmd{'cmd'} =~ s/\${srcdir}/$srcdir/g;
-# $cmd{'cmd'} =~ s|^\./||g;
-#  $cmd{'cmd'} =~ s|tesh|tesh.pl|g;
-  $cmd{'cmd'} =~ s/\(%i:%P@%h\)/\\\(%i:%P@%h\\\)/g;
+  if($OS eq "WIN") {
+      var_subst($cmd{'cmd'}, "EXEEXT", ".exe");
+  } else {
+      var_subst($cmd{'cmd'}, "EXEEXT", "");
+  }
+
+  # substitute environ variables
+  foreach my $key (keys %environ) {
+      $cmd{'cmd'} = var_subst($cmd{'cmd'}, $key, $environ{$key});
+  }
+  # substitute remaining variables, if any
+  while ($cmd{'cmd'} =~ /\${(\w+)(?::[=-][^}]*)?}/) {
+      $cmd{'cmd'} = var_subst($cmd{'cmd'}, $1, "");
+  }
+  while ($cmd{'cmd'} =~ /\$(\w+)/) {
+      $cmd{'cmd'} = var_subst($cmd{'cmd'}, $1, "");
+  }
+
+  # add cfg options
   $cmd{'cmd'} .= " $opts{'cfg'}" if (defined($opts{'cfg'}) && length($opts{'cfg'}));
 
+  # final cleanup
+  $cmd{'cmd'} =~ s/^\s+//;
+  $cmd{'cmd'} =~ s/\s+$//;
+
   print "[$tesh_name:$cmd{'line'}] $cmd{'cmd'}\n" ;
 
   ###
   # exec the command line
-  ###
-  $pid = open3(\*CHILD_IN, \*OUT, \*OUT, $cmd{'cmd'} );
+  ###  $line =~ s/\r//g;
+
+  $cmd{'got'} = IO::File->new_tmpfile;
+  $cmd{'got'}->autoflush(1);
+  local *E = $cmd{'got'};
+  $cmd{'pid'} = open3(\*CHILD_IN,  ">&E",  ">&E",
+                      quotewords('\s+', 0, $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
@@ -258,51 +280,76 @@ sub exec_cmd {
     die "fork() failed: $!" unless defined $forked;
     if ( $forked == 0 ) { # child
       sleep $time_to_wait;
-      kill(9, $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";
-     }
-  }
-  }    
-  close OUT;
-   
-  if ($cmd{'sort'}){   
+    print $diff_tool_tmp_fh "> $got\n" if ($diff_tool);
+
+    if (!($enable_coverage and $got=~ /^profiling:/)){
+      push @got, $got;
+    }
+  }
+
+  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"){
@@ -313,13 +360,13 @@ sub exec_cmd {
     $exitcode=3;
     print STDERR "<$cmd{'file'}:$cmd{'line'}> timeouted. Kill the process.\n";
   }else{
-    $timeout=0;  
+    $timeout=0;
   }
   if($gotret ne $wantret) {
     $error=1;
     my $msg = "Test suite `$cmd{'file'}': NOK (<$cmd{'file'}:$cmd{'line'}> $gotret)\n";
     if ($timeout!=1) {
-        $msg=$msg."Output of <$cmd{'file'}:$cmd{'line'}> so far:\n";    
+        $msg=$msg."Output of <$cmd{'file'}:$cmd{'line'}> so far:\n";
     }
     map {$msg .=  "|| $_\n"} @got;
     if(!@got) {
@@ -333,15 +380,19 @@ sub exec_cmd {
     print STDERR "$msg";
   }
 
-      
+
   ###
-  # Check the result of execution 
+  # Check the result of execution
   ###
   my $diff;
-  if (!defined($cmd{'output ignore'})){
+  if (defined($cmd{'output display'})){
+    print "[Tesh/INFO] Here is the (ignored) command output:\n";
+    map { print "||$_\n" } @got;
+  }
+  elsif (!defined($cmd{'output ignore'})){
     $diff = build_diff(\@{$cmd{'out'}}, \@got);
   }else{
-  print "(ignoring the output of <$cmd{'file'}:$cmd{'line'}> as requested)\n"
+    print "(ignoring the output of <$cmd{'file'}:$cmd{'line'}> as requested)\n"
   }
   if (length $diff) {
     print "Output of <$cmd{'file'}:$cmd{'line'}> mismatch:\n";
@@ -358,7 +409,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'}});
@@ -389,9 +439,9 @@ LINE: while (not $finished and not $error) {
     next LINE;
   }
 
-
   $line_num++;
   chomp $line;
+  $line =~ s/\r//g;
   print "[TESH/debug] $line_num: $line\n" if $opts{'debug'};
   my $next;
   # deal with line continuations
@@ -406,25 +456,25 @@ 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 = ();
     }
+    print $diff_tool_tmp_fh "$line\n" if ($diff_tool);
     next LINE;
-  }     
- 
+  }
+
   my ($cmd,$arg) = ($1,$2);
+  print $diff_tool_tmp_fh "$line\n" if ($diff_tool and $cmd ne '>');
+  $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'};
@@ -471,13 +521,16 @@ LINE: while (not $finished and not $error) {
     $cmd{'cmd'} = $arg;
     $cmd{'file'} = $tesh_file;
     $cmd{'line'} = $line_num;
-  }    
+  }
   elsif($line =~ /^!\s*output sort/){    #output sort
     if (defined($cmd{'cmd'})) {
       exec_cmd(\%cmd);
       %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'})) {
@@ -486,11 +539,19 @@ LINE: while (not $finished and not $error) {
     }
     $cmd{'output ignore'} = 1;
   }
-  elsif($line =~ /^!\s*expect signal (\w*)$/) {#expect signal SIGABRT
+  elsif($line =~ /^!\s*output display/){    #output display
+    if (defined($cmd{'cmd'})) {
+      exec_cmd(\%cmd);
+      %cmd = ();
+    }
+    $cmd{'output display'} = 1;
+  }
+  elsif($line =~ /^!\s*expect signal (\w*)/) {#expect signal SIGABRT
     if (defined($cmd{'cmd'})) {
       exec_cmd(\%cmd);
       %cmd = ();
     }
+print "hey\n";
     $cmd{'expect'} = "$1";
   }
   elsif($line =~ /^!\s*expect return/){    #expect return
@@ -511,7 +572,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 = ();
@@ -531,6 +592,11 @@ LINE: while (not $finished and not $error) {
   } else {
     die "[TESH/CRITICAL] parse error: $line\n";
   }
+  if($forked){
+   kill(SIGKILL, $forked);
+   $timeout=0;
+  }
+
 }
 
 
@@ -543,10 +609,25 @@ if (defined($cmd{'cmd'})) {
 
 
 if($forked){
-   kill(9, $forked);
+   kill(SIGKILL, $forked);
    $timeout=0;
 }
 
+foreach(@bg_cmds){
+  my %test=%{$_};
+  waitpid ($test{'pid'}, 0);
+  $test{'gotret'} = exit_status($?);
+  parse_out(\%test);
+}
+
+@bg_cmds=();
+
+if ($diff_tool) {
+  close $diff_tool_tmp_fh;
+  system("$diff_tool $diff_tool_tmp_filename $tesh_file");
+  unlink $diff_tool_tmp_filename;
+}
+
 if($error !=0){
     exit $exitcode;
 }elsif($tesh_file eq "(stdin)"){
@@ -584,7 +665,7 @@ use Diff qw(diff); # postpone a bit to have time to change INC
 sub build_diff {
   my $res;
   my $diff = Diff->new(@_);
-  
+
   $diff->Base( 1 );   # Return line numbers, not indices
   my $chunk_count = $diff->Next(-1); # Compute the amount of chuncks
   return ""   if ($chunk_count == 1 && $diff->Same());
@@ -595,14 +676,14 @@ sub build_diff {
       if ($diff->Next(0) > 1) { # not first chunk: print 2 first lines
         $res .= '  '.$same[0]."\n" ;
         $res .= '  '.$same[1]."\n" if (scalar @same>1);
-      }     
+      }
       $res .= "...\n"  if (scalar @same>2);
 #    $res .= $diff->Next(0)."/$chunk_count\n";
       if ($diff->Next(0) < $chunk_count) { # not last chunk: print 2 last lines
         $res .= '  '.$same[scalar @same -2]."\n" if (scalar @same>1);
         $res .= '  '.$same[scalar @same -1]."\n";
-      } 
-    } 
+      }
+    }
     next if  $diff->Same();
     map { $res .= "- $_\n" } $diff->Items(1);
     map { $res .= "+ $_\n" } $diff->Items(2);