-#! /usr/bin/perl
+#! /usr/bin/env perl
# Copyright (c) 2012-2014. The SimGrid Team.
# All rights reserved.
B<tesh> [I<options>] I<tesh_file>
=cut
-my($bindir)=".";
-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;
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 => ($OSNAME =~ /^(?: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
+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) {
# 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 {
$tesh_file = pop @ARGV;
# temporary arrays for GetOption
- my @verbose = ();
my @cfg;
my $log; # ignored
my %opt = (
"help" => 0,
"debug" => 0,
- "verbose" => 0
);
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,
print "Test suite `$tesh_name'\n";
}
- $opt{'verbose'} = scalar @verbose;
foreach (@cfg) {
$opt{'cfg'} .= " --cfg=$_";
}
##
## File parsing
##
-my($nb_arg)=0;
-my($old_buffer);
-my($linebis);
-my($SIGABRT)=0;
-my($verbose)=0;
my($return)=-1;
-my($pid);
-my($result);
-my($result_err);
my($forked);
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]};
}
# cleanup the command line
- if($OS eq "WIN") {
+ if(RUNNING_ON_WINDOWS) {
var_subst($cmd{'cmd'}, "EXEEXT", ".exe");
} else {
var_subst($cmd{'cmd'}, "EXEEXT", "");
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;
- }
}
}
}
# parse tesh file
-#my $teshfile=$tesh_file;
-#$teshfile=~ s{\.[^.]+$}{};
-
-unless($tesh_file eq "(stdin)"){
- open TESH_FILE, $tesh_file or die "[Tesh/CRITICAL] Unable to open $tesh_file $!\n";
+my $infh; # The file descriptor from which we should read the teshfile
+if($tesh_file eq "(stdin)"){
+ $infh = *STDIN;
+} else {
+ open $infh, $tesh_file
+ or die "[Tesh/CRITICAL] Unable to open $tesh_file $!\n";
}
my %cmd; # everything about the next command to run
my $line_num=0;
-my $finished =0;
-LINE: while (not $finished and not $error) {
- my $line;
-
-
- if ($tesh_file ne "(stdin)" and !defined($line=<TESH_FILE>)){
- $finished=1;
- next LINE;
- }elsif ($tesh_file eq "(stdin)" and !defined($line=<>)){
- $finished=1;
- next LINE;
- }
-
- $line_num++;
+LINE: while (defined(my $line=<$infh>) and not $error) {
chomp $line;
$line =~ s/\r//g;
+
+ $line_num++;
print "[TESH/debug] $line_num: $line\n" if $opts{'debug'};
my $next;
# deal with line continuations
while ($line =~ /^(.*?)\\$/) {
- $next=<TESH_FILE>;
+ $next=<$infh>;
die "[TESH/CRITICAL] Continued line at end of file\n"
unless defined($next);
$line_num++;
die "[TESH/CRITICAL] parse error: $line\n";
}
if($forked){
- kill(SIGKILL, $forked);
+ kill('KILL', $forked);
$timeout=0;
}
-
}
-
+# We're done reading the input file
+close $infh unless ($tesh_file eq "(stdin)");
# Deal with last command
if (defined($cmd{'cmd'})) {
if($forked){
- kill(SIGKILL, $forked);
+ kill('KILL', $forked);
$timeout=0;
}
