X-Git-Url: http://info.iut-bm.univ-fcomte.fr/pub/gitweb/simgrid.git/blobdiff_plain/9dc613bb976d732f4eb61dd191627bc0edb2368c..47a22ba74687bf963bf797d72745e9f1e6f40dd9:/tools/tesh/tesh.pl diff --git a/tools/tesh/tesh.pl b/tools/tesh/tesh.pl index 5cb808fb9a..d01ce83b85 100755 --- a/tools/tesh/tesh.pl +++ b/tools/tesh/tesh.pl @@ -19,228 +19,321 @@ tesh -- testing shell =head1 SYNOPSIS -B [I] I +B [I]... I + +=head1 DESCRIPTION + +Tesh is the testing shell, a specialized shell for running tests. It +provides the specified input to the tested commands, and check that +they produce the expected output and return the expected value. + +=head1 OPTIONS + + --cd some/directory : ask tesh to switch the working directory before + launching the tests + --setenv var=value : set a specific environment variable + --cfg arg : add parameter --cfg=arg to each command line + --enable-coverage : ignore output lines starting with "profiling:" + +=head1 TEST SUITE FILE SYTAX + +A test suite is composed of one or several I separated +by empty lines, each of them being composed of a command to run, its +input text and the expected output. + +The first char of each line specifies the type of line according to +the following list. The second char of each line is ignored. + + `$' command to run in foreground + `&' command to run in background + + `<' input to pass to the command + `>' output expected from the command + + `!' metacommand, which can be one of: + `timeout' |no + `expect signal' + `expect return' + `output' + `setenv =' + + `p' an informative message to print + +If the expected output do not match the produced output, or if the +command did not end as expected, Tesh provides an error message (see +the OUTPUT section below) and stops. + +=head2 Command blocks examples + +In a given command block, you can declare the command, its input and +its expected output in the order that you see fit. + + $ cat + < TOTO + > TOTO + + > TOTO + $ cat + < TOTO + + > TOTO + < TOTO + $ cat + +You can group several commands together, provided that they don't have +any input nor output. + + $ mkdir testdir + $ cd testdir + +=head2 Enforcing the command return code + +By default, Tesh enforces that the tested command returns 0. If not, +it fails with an appropriate message and returns I itself. + +You specify that a given command block is expected to return another +code as follows: + + # This command MUST return 42 + ! expect return 42 + $ sh -e "exit 42" + +The I construct applies only to the next command block. + +=head2 Commands that are expected to raise signals + +By default, Tesh detects when the command is killed by a signal (such +as SEGV on segfaults). This is usually unexpected and unfortunate. But +if not, you can specify that a given command block is expected to fail +with a signal as follows: + + # This command MUST raise a segfault + ! expect signal SIGSEGV + $ ./some_failing_code + +The I construct applies only to the next command block. + +=head2 Timeouts + +By default, no command is allowed to run more than 5 seconds. You can +change this value as follows: + + # Allow some more time to the command + ! timeout 60 + $ ./some_longer_command + +You can also disable the timeout completely by passing "no" as a value: + + # This command will never timeout + ! timeout no + $ ./some_very_long_but_safe_command + +=head2 Setting environment variables + +You can modify the environment of the tested commands as follows: + + ! setenv PATH=/bin + $ my_command + +=head2 Not enforcing the expected output + +By default, the commands output is matched against the one expected, +and an error is raised on discrepancy. Metacommands to change this: + +=over 4 + +=item output ignore + +The output is completely discarded. + +=item output display + +The output is displayed, but no error is issued if it differs from the +expected output. + +=item output sort + +The output is sorted before comparison (see next section). + +=back + +=head2 Sorting output + +If the order of the command output changes between runs, you want to +sort it before enforcing that it is exactly what you expect. In +SimGrid for example, this happens when parallel execution is +activated: User processes are run in parallel at each timestamp, and +the output is not reproducible anymore. Until you sort the lines. + +You can sort the command output as follows: + + ! output sort + $ ./some_multithreaded_command + +Sorting lines this ways often makes the tesh output very intricate, +complicating the error analysis: the process logical order is defeated +by the lexicographical sort. + +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 +same timestamp. Here is a SimGrid example: + + # Sort only lines depending on the first 19 chars + ! output sort 19 + $ ./some_simgrid_simulator --log=root.fmt:[%10.6r]%e(%i:%P@%h)%e%m%n + +This approach may seem surprizing at the first glance but it does its job: + +=over 4 + +=item Every timestamps remain separated, as it should; + +=item In each timestamp, the output order of processes become + reproducible: that's the lexicographical order of their name; + +=item For each process, the order of its execution is preserved: its + messages within a given timestamp are not reordered. + +=back + +That way, tesh can do its job (no false positive, no false negative) +despite the unpredictable order of executions of processes within a +timestamp, and reported errors remain easy to analyze (execution of a +given process preserved). + +This example is very SimGrid oriented, but the feature could even be +usable by others, who knows? + + +=head1 BUILTIN COMMANDS + +=head2 mkfile: creating a file + +This command creates a file of the name provided as argument, and adds +the content it gets as input. + + $ mkfile myFile + > some content + > to the file + +It is not possible to use the cat command, as one would expect, +because stream redirections are currently not implemented in Tesh. + +=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 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 -my ($timeout) = 0; -my ($time_to_wait) = 0; -my $path = $0; +BEGIN { + # Disabling IPC::Run::Debug saves tons of useless calls. + $ENV{'IPCRUNDEBUG'} = 'none' + unless exists $ENV{'IPCRUNDEBUG'}; +} + my $enable_coverage = 0; my $diff_tool = 0; my $diff_tool_tmp_fh = 0; my $diff_tool_tmp_filename = 0; my $sort_prefix = -1; my $tesh_file; -my $tesh_name; my $error = 0; my $exitcode = 0; my @bg_cmds; my (%environ); $SIG{'PIPE'} = 'IGNORE'; + +my $path = $0; $path =~ s|[^/]*$||; push @INC, $path; +use lib "@CMAKE_BINARY_DIR@/bin"; + +use Diff qw(diff); # postpone a bit to have time to change INC + use Getopt::Long qw(GetOptions); use strict; -use Term::ANSIColor; use Text::ParseWords; -use IPC::Open3; +use IPC::Run qw(start run timeout finish); use IO::File; use English; -## -## Portability bits for windows -## +#### +#### 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) { + if (RUNNING_ON_WINDOWS) { # Missing 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) { - $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]; - 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 ) { - print "Test suite `$tesh_file': NOK (system error)\n"; - exit 4; - } -} -sub setenv_cmd { - my ( $var, $ctn ); - if ( $_[0] =~ /^(.*)=(.*)$/ ) { - ( $var, $ctn ) = ( $1, $2 ); - } elsif ( $_[1] =~ /^(.*)=(.*)$/ ) { - ( $var, $ctn ) = ( $1, $2 ); - } else { - die "[Tesh/CRITICAL] Malformed argument to setenv: expected 'name=value' but got '$_[1]'\n"; + # used on the command lines + $environ{'EXEEXT'} = ".exe"; } - - print "[Tesh/INFO] setenv $var=$ctn\n"; - $environ{$var} = $ctn; } -# Main option parsing sub - -sub get_options { - - # remove the tesh file from the ARGV used - my @ARGV = @_; - $tesh_file = pop @ARGV; - - # temporary arrays for GetOption - my @cfg; - my $log; # ignored - my %opt = ( - "help" => 0, - "debug" => 0, - ); +#### +#### Command line option handling +#### - Getopt::Long::config( 'bundling', 'no_getopt_compat', 'no_auto_abbrev' ); +my %opts = ( "debug" => 0, + "timeout" => 5, # No command should run any longer than 5 seconds by default + ); - GetOptions( - 'help|h' => \$opt{'help'}, +Getopt::Long::config( 'bundling', 'no_getopt_compat', 'no_auto_abbrev' ); +GetOptions( + 'debug|d' => \$opts{"debug"}, - 'debug|d' => \$opt{"debug"}, + 'difftool=s' => \$diff_tool, - 'difftool=s' => \$diff_tool, + 'cd=s' => sub { cd_cmd( $_[1] ) }, + 'timeout=s' => \$opts{'timeout'}, + 'setenv=s' => sub { setenv_cmd( $_[1] ) }, + 'cfg=s' => sub { $opts{'cfg'} .= " --cfg=$_[1]" }, + 'enable-coverage+' => \$enable_coverage, +); - 'cd=s' => \&cd_cmd, - 'timeout=s' => \$opt{'timeout'}, - 'setenv=s' => \&setenv_cmd, - 'cfg=s' => \@cfg, - 'log=s' => \$log, - 'enable-coverage+' => \$enable_coverage, - ); +$tesh_file = pop @ARGV; - 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"; - } - - if ( $tesh_file =~ m/(.*)\.tesh/ ) { - $tesh_name = $1; - print "Test suite `$tesh_name'\n"; - } else { - $tesh_file = "(stdin)"; - $tesh_name = "(stdin)"; - print "Test suite from stdin\n"; - } +print "Enable coverage\n" if ($enable_coverage); - foreach (@cfg) { - $opt{'cfg'} .= " --cfg=$_"; - } - return %opt; +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"; } -my %opts = get_options(@ARGV); - -## -## File parsing -## -my ($return) = -1; -my ($forked); -my ($config) = ""; -my (@buffer_tesh) = (); +if ( $tesh_file =~ m/(.*)\.tesh/ ) { + print "Test suite `$tesh_file'\n"; +} else { + $tesh_file = "(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 "IN BEGIN\n"; - map { print " $_" } @{ $cmd{'in'} }; - print "IN END\n"; - print "OUT BEGIN\n"; - map { print " $_" } @{ $cmd{'out'} }; - print "OUT END\n"; + map { print "IN: $_\n" } @{ $cmd{'in'} }; + map { print "OUT: $_\n" } @{ $cmd{'out'} }; 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} ); } @@ -257,86 +350,118 @@ sub exec_cmd { $cmd{'cmd'} .= " $opts{'cfg'}" if ( defined( $opts{'cfg'} ) && length( $opts{'cfg'} ) ); - # final cleanup + # finally trim any remaining space chars $cmd{'cmd'} =~ s/^\s+//; $cmd{'cmd'} =~ s/\s+$//; - print "[$tesh_name:$cmd{'line'}] $cmd{'cmd'}\n"; + print "[$cmd{'file'}:$cmd{'line'}] $cmd{'cmd'}\n"; + + $cmd{'return'} ||= 0; + $cmd{'timeout'} ||= $opts{'timeout'}; + ### # exec the command line - ### $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'} }; - close CHILD_IN; - - # if timeout specified, fork and kill executing child at the end of 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 - 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 ) { - waitpid( $cmd{'pid'}, 0 ); - $cmd{'gotret'} = exit_status($?); - parse_out( \%cmd ); - } else { + my @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; + $cmd{'job'} = start \@cmdline, '<', \$input, '>&', \$output, + ($cmd{'timeout'} eq 'no' ? () : timeout($cmd{'timeout'})); - # & commands, which will be handled at the end + if ( $cmd{'background'} ) { + # Just enqueue the job. It will be dealed with at the end push @bg_cmds, \%cmd; + } else { + # Deal with its ending conditions right away + analyze_result( \%cmd ); } } -sub parse_out { +sub analyze_result { 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 ); - + $cmd{'timeouted'} = 0; # initialization + + # Wait for the end of the child process + ##### + eval { + finish( $cmd{'job'} ); + }; + if ($@) { # deal with the errors that occured in the child process + if ($@ =~ /timeout/) { + $cmd{'job'}->kill_kill; + $cmd{'timeouted'} = 1; + } 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. + } + } + + # Gather information + #### + # pop all output from executing child my @got; - while ( defined( my $got = ) ) { + map { print "GOT: $_\n" } ${$cmd{'got'}} if $opts{'debug'}; + foreach my $got ( split("\n", ${$cmd{'got'}}) ) { $got =~ s/\r//g; chomp $got; print $diff_tool_tmp_fh "> $got\n" if ($diff_tool); - if ( !( $enable_coverage and $got =~ /^profiling:/ ) ) { + unless ( $enable_coverage and $got =~ /^profiling:/ ) { 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"; + } + + # 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 ); + } - # Save the unsorted observed output to report it on error. - map { push @{ $cmd{'unsorted got'} }, $_ } @got; + # Enforce the outcome + #### + + # Did it end as expected? + if ( $cmd{'gotret'} ne $wantret ) { + $error = 1; + my $msg = "Test suite `$cmd{'file'}': NOK (<$cmd{'file'}:$cmd{'line'}> $cmd{'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? + if ( $cmd{'sort'} ) { sub mysort { substr( $a, 0, $sort_prefix ) cmp substr( $b, 0, $sort_prefix ); } @@ -350,7 +475,7 @@ sub parse_out { 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'} }; @@ -363,80 +488,33 @@ sub parse_out { } } - # Did we timeout ? If yes, handle it. If not, kill the forked process. - - 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"; - $error = 1; - $exitcode = 3; - print STDERR "<$cmd{'file'}:$cmd{'line'}> timeouted. Kill the process.\n"; - } else { - $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"; - } - map { $msg .= "|| $_\n" } @got; - if ( !@got ) { - if ( $timeout == 1 ) { - print STDERR "<$cmd{'file'}:$cmd{'line'}> No output before timeout\n"; - } else { - $msg .= "||\n"; - } - } - $timeout = 0; - print STDERR "$msg"; - } - - ### - # Check the result of execution - ### - 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"; } else { - $diff = build_diff( \@{ $cmd{'out'} }, \@got ); + my $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 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; + } } - 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 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; - } -} - -sub mkfile_cmd { - my %cmd = %{ $_[0] }; - my $file = $cmd{'arg'}; - print "[Tesh/INFO] mkfile $file\n"; - - unlink($file); - open( FILE, ">$file" ) - or die "[Tesh/CRITICAL] Unable to create file $file: $!\n"; - print FILE join( "\n", @{ $cmd{'in'} } ); - print FILE "\n" if ( scalar @{ $cmd{'in'} } > 0 ); - close(FILE); } # parse tesh file @@ -449,18 +527,19 @@ if ( $tesh_file eq "(stdin)" ) { } my %cmd; # everything about the next command to run +my $tesh_name = $tesh_file; +$tesh_name =~ s|^.*?/([^/]*)$|$1|; 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_num++; print "[TESH/debug] $line_num: $line\n" if $opts{'debug'}; - my $next; # deal with line continuations while ( $line =~ /^(.*?)\\$/ ) { - $next = <$infh>; + my $next = <$infh>; die "[TESH/CRITICAL] Continued line at end of file\n" unless defined($next); $line_num++; @@ -469,7 +548,7 @@ LINE: while ( defined( my $line = <$infh> ) and not $error ) { $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 ); @@ -485,31 +564,40 @@ LINE: while ( defined( my $line = <$infh> ) and not $error ) { $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 = (); @@ -520,116 +608,73 @@ LINE: while ( defined( my $line = <$infh> ) and not $error ) { if scalar @{ cmd { 'out' } }; $arg =~ s/^ *cd //; - cd_cmd( "", $arg ); + cd_cmd($arg); %cmd = (); } else { # regular command $cmd{'cmd'} = $arg; - $cmd{'file'} = $tesh_file; + $cmd{'file'} = $tesh_name; $cmd{'line'} = $line_num; } - } elsif ( $cmd eq '&' ) { # parallel 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{'file'} = $tesh_name; $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 = (); - } - print "hey\n"; - $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*include/ ) { #include - if ( defined( $cmd{'cmd'} ) ) { - exec_cmd( \%cmd ); - %cmd = (); - } - print color("red"), "[Tesh/CRITICAL] need include"; - print color("reset"), "\n"; - die; - } 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"; } - if ($forked) { - kill( 'KILL', $forked ); - $timeout = 0; - } } -# We're done reading the input file +# We are done reading the input file close $infh unless ( $tesh_file eq "(stdin)" ); -# Deal with last command +# Deal with last command, if any if ( defined( $cmd{'cmd'} ) ) { exec_cmd( \%cmd ); %cmd = (); } -if ($forked) { - kill( 'KILL', $forked ); - $timeout = 0; -} - foreach (@bg_cmds) { my %test = %{$_}; - waitpid( $test{'pid'}, 0 ); - $test{'gotret'} = exit_status($?); - parse_out( \%test ); + analyze_result( \%test ); } -@bg_cmds = (); - if ($diff_tool) { close $diff_tool_tmp_fh; system("$diff_tool $diff_tool_tmp_filename $tesh_file"); @@ -644,31 +689,11 @@ if ( $error != 0 ) { print "Test suite `$tesh_name' OK\n"; } -#my (@a,@b); -#push @a,"bl1"; push @b,"bl1"; -#push @a,"bl2"; push @b,"bl2"; -#push @a,"bl3"; push @b,"bl3"; -#push @a,"bl4"; push @b,"bl4"; -#push @a,"bl5"; push @b,"bl5"; -#push @a,"bl6"; push @b,"bl6"; -#push @a,"bl7"; push @b,"bl7"; -##push @a,"Perl"; push @b,"ruby"; -#push @a,"END1"; push @b,"END1"; -#push @a,"END2"; push @b,"END2"; -#push @a,"END3"; push @b,"END3"; -#push @a,"END4"; push @b,"END4"; -#push @a,"END5"; push @b,"END5"; -#push @a,"END6"; push @b,"END6"; -#push @a,"END7"; push @b,"END7"; -#print "Identical:\n". build_diff(\@a,\@b); - -#@a = (); @b =(); -#push @a,"AZE"; push @b,"EZA"; -#print "Different:\n".build_diff(\@a,\@b); +exit 0; -use lib "@CMAKE_BINARY_DIR@/bin"; - -use Diff qw(diff); # postpone a bit to have time to change INC +#### +#### Helper functions +#### sub build_diff { my $res; @@ -701,3 +726,65 @@ sub build_diff { return $res; } +# Helper function replacing any occurence of variable '$name' by its '$value' +# As in Bash, ${$value:=BLABLA} is rewritten to $value if set or to BLABLA if $value is not set +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; +} + +################################ The possible commands ################################ + +sub mkfile_cmd($) { + my %cmd = %{ $_[0] }; + my $file = $cmd{'arg'}; + print STDERR "[Tesh/INFO] mkfile $file. Ctn: >>".join( '\n', @{ $cmd{'in'} })."<<\n" + if $opts{'debug'}; + + unlink($file); + open( FILE, ">$file" ) + or die "[Tesh/CRITICAL] Unable to create file $file: $!\n"; + print FILE join( "\n", @{ $cmd{'in'} } ); + print FILE "\n" if ( scalar @{ $cmd{'in'} } > 0 ); + close(FILE); +} + +# Command CD. Just change to the provided directory +sub cd_cmd($) { + my $directory = shift; + 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 ) { + print "Test suite `$cmd{'filefile'}': NOK (system error)\n"; + exit 4; + } +} + +# Command setenv. Gets "variable=content", and update the environment accordingly +sub setenv_cmd($) { + my $arg = shift; + if ( $arg =~ /^(.*)=(.*)$/ ) { + my ( $var, $ctn ) = ( $1, $2 ); + print "[Tesh/INFO] setenv $var=$ctn\n"; + $environ{$var} = $ctn; + $ENV{$var} = $ctn; + } else { + die "[Tesh/CRITICAL] Malformed argument to setenv: expected 'name=value' but got '$arg'\n"; + } +}