launching the tests
--setenv var=value : set a specific environment variable
--cfg arg : add parameter --cfg=arg to each command line
+ --log arg : add parameter --log=arg to each command line
--enable-coverage : ignore output lines starting with "profiling:"
+ --enable-sanitizers : ignore output lines starting with containing warnings
=head1 TEST SUITE FILE SYTAX
The solution is to prefix each line of your output with temporal
information so that lines can be grouped by timestamps. The
-lexicographical sort then only applies to lines that occured at the
+lexicographical sort then only applies to lines that occurred at the
same timestamp. Here is a SimGrid example:
# Sort only lines depending on the first 19 chars
It is not possible to use the cat command, as one would expect,
because stream redirections are currently not implemented in Tesh.
-=head1 BUGS AND LIMITATIONS
+=head1 BUGS, LIMITATIONS AND POSSIBLE IMPROVEMENTS
The main limitation is the lack of stream redirections in the commands
(">", "<" and "|" shell constructs and friends). The B<mkfile> builtin
command makes this situation bearable.
+It would be nice if we could replace the tesh file completely with
+command line flags when the output is not to be verified.
+
=cut
BEGIN {
}
my $enable_coverage = 0;
+my $enable_sanitizers = 0;
my $diff_tool = 0;
my $diff_tool_tmp_fh = 0;
my $diff_tool_tmp_filename = 0;
*WEXITSTATUS = sub { $_[0] >> 8 };
*WIFSIGNALED = sub { ( $_[0] & 127 ) && ( $_[0] & 127 != 127 ) };
*WTERMSIG = sub { $_[0] & 127 };
+
+ # used on the command lines
+ $environ{'EXEEXT'} = ".exe";
}
}
'timeout=s' => \$opts{'timeout'},
'setenv=s' => sub { setenv_cmd( $_[1] ) },
'cfg=s' => sub { $opts{'cfg'} .= " --cfg=$_[1]" },
+ 'log=s' => sub { $opts{'log'} .= " --log=$_[1]" },
'enable-coverage+' => \$enable_coverage,
+ 'enable-sanitizers+' => \$enable_sanitizers,
);
$tesh_file = pop @ARGV;
+$tesh_name = $tesh_file;
+$tesh_name =~ s|^.*?/([^/]*)$|$1|;
print "Enable coverage\n" if ($enable_coverage);
+print "Enable sanitizers\n" if ($enable_sanitizers);
if ($diff_tool) {
use File::Temp qw/ tempfile /;
}
if ( $tesh_file =~ m/(.*)\.tesh/ ) {
- $tesh_name = $1;
- print "Test suite `$tesh_name'\n";
+ print "Test suite `$tesh_file'\n";
} else {
- $tesh_file = "(stdin)";
$tesh_name = "(stdin)";
print "Test suite from stdin\n";
}
###########################################################################
-sub exit_status {
- my $status = shift;
- 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?";
-}
-
sub exec_cmd {
my %cmd = %{ $_[0] };
if ( $opts{'debug'} ) {
print "CMD: $cmd{'cmd'}\n";
}
- # cleanup the command line
- if (RUNNING_ON_WINDOWS) {
- var_subst( $cmd{'cmd'}, "EXEEXT", ".exe" );
- } else {
- var_subst( $cmd{'cmd'}, "EXEEXT", "" );
- }
-
- # substitute environ variables
+ # substitute environment variables
foreach my $key ( keys %environ ) {
$cmd{'cmd'} = var_subst( $cmd{'cmd'}, $key, $environ{$key} );
}
# substitute remaining variables, if any
- while ( $cmd{'cmd'} =~ /\${(\w+)(?::[=-][^}]*)?}/ ) {
+ 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
+ # add cfg and log options
$cmd{'cmd'} .= " $opts{'cfg'}"
if ( defined( $opts{'cfg'} ) && length( $opts{'cfg'} ) );
+ $cmd{'cmd'} .= " $opts{'log'}"
+ if ( defined( $opts{'log'} ) && length( $opts{'log'} ) );
# finally trim any remaining space chars
$cmd{'cmd'} =~ s/^\s+//;
###
# exec the command line
- my @cmdline = quotewords( '\s+', 0, $cmd{'cmd'} );
+ my @cmdline;
+ if(defined $ENV{VALGRIND_COMMAND}) {
+ push @cmdline, $ENV{VALGRIND_COMMAND};
+ push @cmdline, split(" ", $ENV{VALGRIND_OPTIONS});
+ if($cmd{'timeout'} ne 'no'){
+ $cmd{'timeout'}=$cmd{'timeout'}*20
+ }
+ }
+ push @cmdline, quotewords( '\s+', 0, $cmd{'cmd'} );
my $input = defined($cmd{'in'})? join("\n",@{$cmd{'in'}}) : "";
my $output = " " x 10240; $output = ""; # Preallocate 10kB, and reset length to 0
$cmd{'got'} = \$output;
sub analyze_result {
my %cmd = %{ $_[0] };
-
+ $cmd{'timeouted'} = 0; # initialization
+
+ # Wait for the end of the child process
+ #####
eval {
finish( $cmd{'job'} );
};
- if ($@) {
+ if ($@) { # deal with the errors that occurred in the child process
if ($@ =~ /timeout/) {
$cmd{'job'}->kill_kill;
$cmd{'timeouted'} = 1;
- } elsif ($@ =~ /^ack / and $@ =~ /pipe/) {
+ } elsif ($@ =~ /^ack / and $@ =~ /pipe/) { # IPC::Run is not very expressive about the pipes that it gets :(
print STDERR "Tesh: Broken pipe (ignored).\n";
} else {
die $@; # Don't know what it is, so let it go.
}
}
- $cmd{'timeouted'} ||= 0;
-
- my $gotret = $cmd{'gotret'} = exit_status($?);
-
- 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 );
- }
+ # Gather information
+ ####
+
# pop all output from executing child
my @got;
map { print "GOT: $_\n" } ${$cmd{'got'}} if $opts{'debug'};
chomp $got;
print $diff_tool_tmp_fh "> $got\n" if ($diff_tool);
- unless ( $enable_coverage and $got =~ /^profiling:/ ) {
+ unless (( $enable_coverage and $got =~ /^profiling:/ ) or
+ ( $enable_sanitizers and $got =~ m/WARNING: ASan doesn't fully support/))
+ {
push @got, $got;
- }
+ }
}
- if ( $cmd{'sort'} ) {
+ # How did the child process terminate?
+ my $status = $?;
+ $cmd{'gotret'} = "Unparsable status. Please report this tesh bug.";
+ if ( $cmd{'timeouted'} ) {
+ $cmd{'gotret'} = "timeout after $cmd{'timeout'} sec";
+ $error = 1;
+ $exitcode = 3;
+ } elsif ( WIFEXITED($status) ) {
+ $exitcode = WEXITSTATUS($status) + 40;
+ $cmd{'gotret'} = "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;
+ $cmd{'gotret'} = "got signal $code";
+ }
- # Save the unsorted observed output to report it on error.
- map { push @{ $cmd{'unsorted got'} }, $_ } @got;
+ # How was it supposed to terminate?
+ 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 );
+ }
+ # Enforce the outcome
+ ####
+
+ # Did it end as expected?
+ if ( $cmd{'gotret'} ne $wantret ) {
+ $error = 1;
+ my $msg = "Test suite `$tesh_name': NOK (<$tesh_name:$cmd{'line'}> $cmd{'gotret'})\n";
+ if ( scalar @got ) {
+ $msg = $msg . "Output of <$tesh_name:$cmd{'line'}> so far:\n";
+ map { $msg .= "|| $_\n" } @got;
+ } else {
+ $msg .= "<$tesh_name:$cmd{'line'}> No output so far.\n";
+ }
+ print STDERR "$msg";
+ }
+
+ # Does the output match?
+ if ( $cmd{'sort'} ) {
sub mysort {
substr( $a, 0, $sort_prefix ) cmp substr( $b, 0, $sort_prefix );
}
shift @got;
}
- # Sort the expected output to make it easier to write for humans
+ # Sort the expected output too, to make tesh files easier to write for humans
if ( defined( $cmd{'out'} ) ) {
if ( $sort_prefix > 0 ) {
@{ $cmd{'out'} } = sort mysort @{ $cmd{'out'} };
}
}
- # Did we timeout?
-
- if ( $cmd{'timeouted'} ) {
- $gotret = "timeout after $cmd{'timeout'} sec";
- $error = 1;
- $exitcode = 3;
- print STDERR "<$cmd{'file'}:$cmd{'line'}> timeouted. Kill the process.\n";
- }
- if ( $gotret ne $wantret ) {
- $error = 1;
- my $msg = "Test suite `$cmd{'file'}': NOK (<$cmd{'file'}:$cmd{'line'}> $gotret)\n";
- if ( scalar @got ) {
- $msg = $msg . "Output of <$cmd{'file'}:$cmd{'line'}> so far:\n";
- map { $msg .= "|| $_\n" } @got;
- } else {
- $msg .= "<$cmd{'file'}:$cmd{'line'}> No output so far.\n";
- }
- print STDERR "$msg";
- }
-
- # Does the output match?
- my $diff;
+ # Report the output if asked so or if it differs
if ( defined( $cmd{'output display'} ) ) {
print "[Tesh/INFO] Here is the (ignored) command output:\n";
map { print "||$_\n" } @got;
} elsif ( defined( $cmd{'output ignore'} ) ) {
- print "(ignoring the output of <$cmd{'file'}:$cmd{'line'}> as requested)\n";
+ print "(ignoring the output of <$tesh_name:$cmd{'line'}> as requested)\n";
} else {
- $diff = build_diff( \@{ $cmd{'out'} }, \@got );
- }
- if ( length $diff ) {
- 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: 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";
- exit 2;
+ my $diff = build_diff( \@{ $cmd{'out'} }, \@got );
+
+ if ( length $diff ) {
+ print "Output of <$tesh_name:$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: 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 `$tesh_name': NOK (<$tesh_name:$cmd{'line'}> output mismatch)\n";
+ exit 2;
+ }
}
}
# parse tesh file
my $infh; # The file descriptor from which we should read the teshfile
-if ( $tesh_file eq "(stdin)" ) {
+if ( $tesh_name eq "(stdin)" ) {
$infh = *STDIN;
} else {
open $infh, $tesh_file
my %cmd; # everything about the next command to run
my $line_num = 0;
-LINE: while ( defined( my $line = <$infh> ) and not $error ) {
+LINE: while ( not $error and defined( my $line = <$infh> )) {
chomp $line;
$line =~ s/\r//g;
$line = $1 . $next;
}
- # Push delayed commands on empty lines
+ # If the line is empty, run any previously defined block and proceed to next line
unless ( $line =~ m/^(.)(.*)$/ ) {
if ( defined( $cmd{'cmd'} ) ) {
exec_cmd( \%cmd );
$arg =~ s/\r//g;
$arg =~ s/\\\\/\\/g;
- # handle the commands
+ # Deal with the lines that can contribute to the current command block
if ( $cmd =~ /^#/ ) { # comment
+ next LINE;
} elsif ( $cmd eq '>' ) { # expected result line
print "[TESH/debug] push expected result\n" if $opts{'debug'};
push @{ $cmd{'out'} }, $arg;
+ next LINE;
} elsif ( $cmd eq '<' ) { # provided input
print "[TESH/debug] push provided input\n" if $opts{'debug'};
push @{ $cmd{'in'} }, $arg;
+ next LINE;
} elsif ( $cmd eq 'p' ) { # comment
print "[$tesh_name:$line_num] $arg\n";
+ next LINE;
- } elsif ( $cmd eq '$' ) { # Command
- # if we have something buffered, run it now
- if ( defined( $cmd{'cmd'} ) ) {
- exec_cmd( \%cmd );
- %cmd = ();
- }
- if ( $arg =~ /^\s*mkfile / ) { # "mkfile" command line
+ }
+
+ # We dealt with all sort of lines that can contribute to a command block, so we have something else here.
+ # If we have something buffered, run it now and start a new block
+ if ( defined( $cmd{'cmd'} ) ) {
+ exec_cmd( \%cmd );
+ %cmd = ();
+ }
+
+ # Deal with the lines that must be placed before a command block
+ if ( $cmd eq '$' ) { # Command
+ if ( $arg =~ /^mkfile / ) { # "mkfile" command line
die "[TESH/CRITICAL] Output expected from mkfile command!\n"
if scalar @{ cmd { 'out' } };
$cmd{'arg'} = $arg;
- $cmd{'arg'} =~ s/\s*mkfile //;
+ $cmd{'arg'} =~ s/mkfile //;
mkfile_cmd( \%cmd );
%cmd = ();
} else { # regular command
$cmd{'cmd'} = $arg;
- $cmd{'file'} = $tesh_file;
$cmd{'line'} = $line_num;
}
- } elsif ( $cmd eq '&' ) { # background command line
- if ( defined( $cmd{'cmd'} ) ) {
- exec_cmd( \%cmd );
- %cmd = ();
- }
+ } elsif ( $cmd eq '&' ) { # background command line
+ die "[TESH/CRITICAL] mkfile cannot be run in background\n"
+ if ($arg =~ /^mkfile/);
+ die "[TESH/CRITICAL] cd cannot be run in background\n"
+ if ($arg =~ /^cd/);
+
$cmd{'background'} = 1;
$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'} ) ) {
- exec_cmd( \%cmd );
- %cmd = ();
- }
- $cmd{'output ignore'} = 1;
- } 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 = ();
- }
- $cmd{'expect'} = "$1";
- } elsif ( $line =~ /^!\s*expect return/ ) { #expect return
- if ( defined( $cmd{'cmd'} ) ) {
- exec_cmd( \%cmd );
- %cmd = ();
- }
- $line =~ s/^! expect return //g;
- $line =~ s/\r//g;
- $cmd{'return'} = $line;
- } elsif ( $line =~ /^!\s*setenv/ ) { #setenv
- if ( defined( $cmd{'cmd'} ) ) {
- exec_cmd( \%cmd );
- %cmd = ();
- }
- $line =~ s/^! setenv //g;
- $line =~ s/\r//g;
- setenv_cmd($line);
- } elsif ( $line =~ /^!\s*timeout/ ) { #timeout
- if ( defined( $cmd{'cmd'} ) ) {
- exec_cmd( \%cmd );
- %cmd = ();
- }
- $line =~ s/^! timeout //;
- $line =~ s/\r//g;
- $cmd{'timeout'} = $line;
+ # Deal with the meta-commands
+ } elsif ( $line =~ /^! (.*)/) {
+ $line = $1;
+
+ if ( $line =~ /^output sort/ ) {
+ $cmd{'sort'} = 1;
+ if ( $line =~ /^output sort\s+(\d+)/ ) {
+ $sort_prefix = $1;
+ }
+ } elsif ($line =~ /^output ignore/ ) {
+ $cmd{'output ignore'} = 1;
+ } elsif ( $line =~ /^output display/ ) {
+ $cmd{'output display'} = 1;
+ } elsif ( $line =~ /^expect signal (\w*)/ ) {
+ $cmd{'expect'} = $1;
+ } elsif ( $line =~ /^expect return/ ) {
+ $line =~ s/^expect return //g;
+ $line =~ s/\r//g;
+ $cmd{'return'} = $line;
+ } elsif ( $line =~ /^setenv/ ) {
+ $line =~ s/^setenv //g;
+ $line =~ s/\r//g;
+ setenv_cmd($line);
+ } elsif ( $line =~ /^timeout/ ) {
+ $line =~ s/^timeout //;
+ $line =~ s/\r//g;
+ $cmd{'timeout'} = $line;
+ }
} else {
die "[TESH/CRITICAL] parse error: $line\n";
}
}
-# We're done reading the input file
-close $infh unless ( $tesh_file eq "(stdin)" );
+# We are done reading the input file
+close $infh unless ( $tesh_name eq "(stdin)" );
-# Deal with last command
+# Deal with last command, if any
if ( defined( $cmd{'cmd'} ) ) {
exec_cmd( \%cmd );
%cmd = ();
if ( $error != 0 ) {
exit $exitcode;
-} elsif ( $tesh_file eq "(stdin)" ) {
+} elsif ( $tesh_name eq "(stdin)" ) {
print "Test suite from stdin OK\n";
} else {
print "Test suite `$tesh_name' OK\n";
sub var_subst {
my ( $text, $name, $value ) = @_;
if ($value) {
- $text =~ s/\${$name(?::[=-][^}]*)?}/$value/g;
+ $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:=([^}]*)\}/$1/g;
+ $text =~ s/\$\{$name\}//g;
$text =~ s/\$$name(\W|$)/$1/g;
}
return $text;
print "Chdir to $directory failed: No such file or directory\n";
}
if ( $failure == 1 ) {
- print "Test suite `$tesh_file': NOK (system error)\n";
+ print "Test suite `$tesh_name': NOK (system error)\n";
exit 4;
}
}
# Command setenv. Gets "variable=content", and update the environment accordingly
sub setenv_cmd($) {
my $arg = shift;
- if ( $arg =~ /^(.*)=(.*)$/ ) {
+ if ( $arg =~ /^(.*?)=(.*)$/ ) {
my ( $var, $ctn ) = ( $1, $2 );
print "[Tesh/INFO] setenv $var=$ctn\n";
$environ{$var} = $ctn;