-#! /usr/bin/perl
+#! /usr/bin/env perl
# Copyright (c) 2012-2014. The SimGrid Team.
# All rights reserved.
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"){
+# Existing OSes: https://metacpan.org/source/SMUELLER/PathTools-3.47/lib/File/Spec.pm
+if($^O eq "linux" || $^O eq "MacOS"){
$OS = "UNIX";
-}
-else{
+} elsif ($^O eq "MSWin32") {
$OS = "WIN";
$ENV{"PRINTF_EXPONENT_DIGITS"} = "2";
+} else {
+ die "Tesh: Unknown operating system: $^O\n";
}
+use if $^O eq 'MSWin32', 'Win32::Job';
##
## Command line option handling
die "fork() failed: $!" unless defined $forked;
if ( $forked == 0 ) { # child
sleep $time_to_wait;
- kill(SIGKILL, $cmd{'pid'});
+ if ($OS eq "UNIX") {
+ kill(SIGTERM, $cmd{'pid'});
+ sleep 1;
+ kill(SIGKILL, $cmd{'pid'});
+ } elsif ($OS eq "WIN") {
+ system("TASKKILL /F /T /PID $cmd{'pid'}");
+ # /F: Forcefully
+ # /T: Tree kill
+ # /PID: poor soul
+ }
exit $time_to_wait;
}
}
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.
- 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 "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 "----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";
+ 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";
}
print "Test suite `$cmd{'file'}': NOK (<$cmd{'file'}:$cmd{'line'}> output mismatch)\n";