-#! /usr/bin/perl
+#! /usr/bin/env perl
# Copyright (c) 2012-2014. The SimGrid Team.
# All rights reserved.
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;
my $diff_tool_tmp_filename=0;
-my $sort_prefix = 19;
+my $sort_prefix = -1;
my $tesh_file;
my $tesh_name;
my $error=0;
use IPC::Open3;
use IO::File;
-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
##
# 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 {
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]};
}
# cleanup the command line
- if($OS eq "WIN") {
+ if(RUNNING_ON_WINDOWS) {
var_subst($cmd{'cmd'}, "EXEEXT", ".exe");
} else {
var_subst($cmd{'cmd'}, "EXEEXT", "");
die "fork() failed: $!" unless defined $forked;
if ( $forked == 0 ) { # child
sleep $time_to_wait;
- kill(SIGKILL, $cmd{'pid'});
+# if (RUNNING_ON_WINDOWS) {
+# system("TASKKILL /F /T /PID $cmd{'pid'}");
+# # /F: Forcefully
+# # /T: Tree kill
+# # /PID: poor soul
+# } else {
+ kill('TERM', $cmd{'pid'});
+ sleep 1;
+ kill('KILL', $cmd{'pid'});
+# }
exit $time_to_wait;
}
}
}
if ($cmd{'sort'}){
+ # Save the unsorted observed output to report it on error.
+ map { push @{$cmd{'unsorted got'}}, $_ } @got;
+
sub mysort{
substr($a, 0, $sort_prefix) cmp substr($b, 0, $sort_prefix)
}
use sort 'stable';
- @got = sort mysort @got;
+ if ($sort_prefix>0) {
+ @got = sort mysort @got;
+ } else {
+ @got = sort @got;
+ }
while (@got and $got[0] eq "") {
shift @got;
}
# Sort the expected output to make it easier to write for humans
if(defined($cmd{'out'})){
- @{$cmd{'out'}}=sort mysort @{$cmd{'out'}};
+ if ($sort_prefix>0) {
+ @{$cmd{'out'}} = sort mysort @{$cmd{'out'}};
+ } else {
+ @{$cmd{'out'}} = sort @{$cmd{'out'}};
+ }
while (@{$cmd{'out'}} and ${$cmd{'out'}}[0] eq "") {
shift @{$cmd{'out'}};
}
}
}
- #Did we timeout ? If yes, handle it. If not, kill the forked process.
+ # 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";
print "(ignoring the output of <$cmd{'file'}:$cmd{'line'}> as requested)\n"
}
if (length $diff) {
- print "Output of <$cmd{'file'}:$cmd{'line'}> mismatch:\n";
+ print "Output of <$cmd{'file'}:$cmd{'line'}> mismatch".($cmd{'sort'}?" (even after sorting)":"").":\n";
+ map { print "$_\n" } split(/\n/,$diff);
if ($cmd{'sort'}) {
- print "WARNING: both the observed output and expected output were sorted as requested\n";
+ print "WARNING: Both the observed output and expected output were sorted as requested.\n";
+ print "WARNING: Output were only sorted using the $sort_prefix first chars.\n"
+ if ($sort_prefix>0);
+ print "WARNING: Use <! output sort 19> to sort by simulated date and process ID only.\n";
+ # print "----8<--------------- Begin of unprocessed observed output (as it should appear in file):\n";
+ # map {print "> $_\n"} @{$cmd{'unsorted got'}};
+ # print "--------------->8---- End of the unprocessed observed output.\n";
}
- map { print "$_\n" } split(/\n/,$diff);
print "Test suite `$cmd{'file'}': NOK (<$cmd{'file'}:$cmd{'line'}> output mismatch)\n";
$error=1;
