Logo AND Algorithmique Numérique Distribuée

Public GIT Repository
Crude hack to ignore cruft from Java on Windows
[simgrid.git] / tools / tesh / tesh.pl
1 #! /usr/bin/env perl
2
3 # Copyright (c) 2012-2015. The SimGrid Team.
4 # All rights reserved.
5
6 # This program is free software; you can redistribute it and/or modify it
7 # under the terms of the license (GNU LGPL) which comes with this package.
8 eval 'exec perl -S $0 ${1+"$@"}'
9   if $running_under_some_shell;
10
11 # If you change this file, please stick to the formatting you got with:
12 # perltidy --backup-and-modify-in-place --maximum-line-length=180 --output-line-ending=unix --cuddled-else
13
14 =encoding UTF-8
15
16 =head1 NAME
17
18 tesh -- testing shell
19
20 =head1 SYNOPSIS
21
22 B<tesh> [I<options>]... I<testsuite>
23
24 =head1 DESCRIPTION
25
26 Tesh is the testing shell, a specialized shell for running tests. It
27 provides the specified input to the tested commands, and check that
28 they produce the expected output and return the expected value.
29
30 =head1 OPTIONS
31
32   --cd some/directory : ask tesh to switch the working directory before
33                         launching the tests
34   --setenv var=value  : set a specific environment variable
35   --cfg arg           : add parameter --cfg=arg to each command line
36   --log arg           : add parameter --log=arg to each command line
37   --enable-coverage   : ignore output lines starting with "profiling:"
38   --enable-sanitizers : ignore output lines starting with containing warnings
39
40 =head1 TEST SUITE FILE SYTAX
41
42 A test suite is composed of one or several I<command blocks> separated
43 by empty lines, each of them being composed of a command to run, its
44 input text and the expected output.
45
46 The first char of each line specifies the type of line according to
47 the following list. The second char of each line is ignored.
48
49  `$' command to run in foreground
50  `&' command to run in background
51
52  `<' input to pass to the command
53  `>' output expected from the command
54
55  `!' metacommand, which can be one of:
56      `timeout' <integer>|no
57      `expect signal' <signal name>
58      `expect return' <integer>
59      `output' <ignore|display>
60      `setenv <key>=<val>'
61
62  `p' an informative message to print
63
64 If the expected output do not match the produced output, or if the
65 command did not end as expected, Tesh provides an error message (see
66 the OUTPUT section below) and stops.
67
68 =head2 Command blocks examples
69
70 In a given command block, you can declare the command, its input and
71 its expected output in the order that you see fit.
72
73     $ cat
74     < TOTO
75     > TOTO
76
77     > TOTO
78     $ cat
79     < TOTO
80
81     > TOTO
82     < TOTO
83     $ cat
84
85 You can group several commands together, provided that they don't have
86 any input nor output.
87
88     $ mkdir testdir
89     $ cd testdir
90
91 =head2 Enforcing the command return code
92
93 By default, Tesh enforces that the tested command returns 0. If not,
94 it fails with an appropriate message and returns I<code+40> itself.
95
96 You specify that a given command block is expected to return another
97 code as follows:
98
99     # This command MUST return 42
100     ! expect return 42
101     $ sh -e "exit 42"
102
103 The I<expect return> construct applies only to the next command block.
104
105 =head2 Commands that are expected to raise signals
106
107 By default, Tesh detects when the command is killed by a signal (such
108 as SEGV on segfaults). This is usually unexpected and unfortunate. But
109 if not, you can specify that a given command block is expected to fail
110 with a signal as follows:
111
112     # This command MUST raise a segfault
113     ! expect signal SIGSEGV
114     $ ./some_failing_code
115
116 The I<expect signal> construct applies only to the next command block.
117
118 =head2 Timeouts
119
120 By default, no command is allowed to run more than 5 seconds. You can
121 change this value as follows:
122
123     # Allow some more time to the command
124     ! timeout 60
125     $ ./some_longer_command
126
127 You can also disable the timeout completely by passing "no" as a value:
128
129     # This command will never timeout
130     ! timeout no
131     $ ./some_very_long_but_safe_command
132
133 =head2 Setting environment variables
134
135 You can modify the environment of the tested commands as follows:
136
137     ! setenv PATH=/bin
138     $ my_command
139
140 =head2 Not enforcing the expected output 
141
142 By default, the commands output is matched against the one expected,
143 and an error is raised on discrepancy. Metacommands to change this:
144
145 =over 4
146
147 =item output ignore
148
149 The output is completely discarded.
150
151 =item output display
152
153 The output is displayed, but no error is issued if it differs from the
154 expected output.
155
156 =item output sort
157
158 The output is sorted before comparison (see next section).
159
160 =back
161
162 =head2 Sorting output
163
164 If the order of the command output changes between runs, you want to
165 sort it before enforcing that it is exactly what you expect. In
166 SimGrid for example, this happens when parallel execution is
167 activated: User processes are run in parallel at each timestamp, and
168 the output is not reproducible anymore. Until you sort the lines.
169
170 You can sort the command output as follows:
171
172     ! output sort
173     $ ./some_multithreaded_command
174
175 Sorting lines this ways often makes the tesh output very intricate,
176 complicating the error analysis: the process logical order is defeated
177 by the lexicographical sort.
178
179 The solution is to prefix each line of your output with temporal
180 information so that lines can be grouped by timestamps. The
181 lexicographical sort then only applies to lines that occurred at the
182 same timestamp. Here is a SimGrid example:
183
184     # Sort only lines depending on the first 19 chars
185     ! output sort 19
186     $ ./some_simgrid_simulator --log=root.fmt:[%10.6r]%e(%i:%P@%h)%e%m%n
187
188 This approach may seem surprizing at the first glance but it does its job:
189
190 =over 4
191
192 =item Every timestamps remain separated, as it should; 
193
194 =item In each timestamp, the output order of processes become
195    reproducible: that's the lexicographical order of their name;
196
197 =item For each process, the order of its execution is preserved: its
198    messages within a given timestamp are not reordered.
199
200 =back
201
202 That way, tesh can do its job (no false positive, no false negative)
203 despite the unpredictable order of executions of processes within a
204 timestamp, and reported errors remain easy to analyze (execution of a
205 given process preserved).
206
207 This example is very SimGrid oriented, but the feature could even be
208 usable by others, who knows?
209
210
211 =head1 BUILTIN COMMANDS
212
213 =head2 mkfile: creating a file
214
215 This command creates a file of the name provided as argument, and adds
216 the content it gets as input.
217
218   $ mkfile myFile
219   > some content
220   > to the file
221
222 It is not possible to use the cat command, as one would expect,
223 because stream redirections are currently not implemented in Tesh.
224
225 =head1 BUGS, LIMITATIONS AND POSSIBLE IMPROVEMENTS
226
227 The main limitation is the lack of stream redirections in the commands
228 (">", "<" and "|" shell constructs and friends). The B<mkfile> builtin
229 command makes this situation bearable.
230
231 It would be nice if we could replace the tesh file completely with
232 command line flags when the output is not to be verified.
233
234 =cut
235
236 BEGIN {
237     # Disabling IPC::Run::Debug saves tons of useless calls.
238     $ENV{'IPCRUNDEBUG'} = 'none'
239       unless exists $ENV{'IPCRUNDEBUG'};
240 }
241
242 my $enable_coverage        = 0;
243 my $enable_sanitizers        = 0;
244 my $diff_tool              = 0;
245 my $diff_tool_tmp_fh       = 0;
246 my $diff_tool_tmp_filename = 0;
247 my $sort_prefix            = -1;
248 my $tesh_file;
249 my $tesh_name;
250 my $error    = 0;
251 my $exitcode = 0;
252 my @bg_cmds;
253 my (%environ);
254 $SIG{'PIPE'} = 'IGNORE';
255
256 my $path = $0;
257 $path =~ s|[^/]*$||;
258 push @INC, $path;
259
260 use lib "@CMAKE_BINARY_DIR@/bin";
261
262 use Diff qw(diff);    # postpone a bit to have time to change INC
263
264 use Getopt::Long qw(GetOptions);
265 use strict;
266 use Text::ParseWords;
267 use IPC::Run qw(start run timeout finish);
268 use IO::File;
269 use English;
270
271 ####
272 #### Portability bits for windows
273 ####
274
275 use constant RUNNING_ON_WINDOWS => ( $OSNAME =~ /^(?:mswin|dos|os2)/oi );
276 use POSIX qw(:sys_wait_h WIFEXITED WIFSIGNALED WIFSTOPPED WEXITSTATUS WTERMSIG WSTOPSIG
277   :signal_h SIGINT SIGTERM SIGKILL SIGABRT SIGSEGV);
278
279 BEGIN {
280     if (RUNNING_ON_WINDOWS) { # Missing on windows
281         *WIFEXITED   = sub { not $_[0] & 127 };
282         *WEXITSTATUS = sub { $_[0] >> 8 };
283         *WIFSIGNALED = sub { ( $_[0] & 127 ) && ( $_[0] & 127 != 127 ) };
284         *WTERMSIG    = sub { $_[0] & 127 };
285
286         # used on the command lines
287         $environ{'EXEEXT'} = ".exe";
288     }
289 }
290
291
292 ####
293 #### Command line option handling
294 ####
295
296 my %opts = ( "debug" => 0,
297              "timeout" => 5, # No command should run any longer than 5 seconds by default
298            );
299
300 Getopt::Long::config( 'bundling', 'no_getopt_compat', 'no_auto_abbrev' );
301 GetOptions(
302     'debug|d' => \$opts{"debug"},
303
304     'difftool=s' => \$diff_tool,
305
306     'cd=s'      => sub { cd_cmd( $_[1] ) },
307     'timeout=s' => \$opts{'timeout'},
308     'setenv=s'  => sub { setenv_cmd( $_[1] ) },
309     'cfg=s' => sub { $opts{'cfg'} .= " --cfg=$_[1]" },
310     'log=s' => sub { $opts{'log'} .= " --log=$_[1]" },
311     'enable-coverage+' => \$enable_coverage,
312     'enable-sanitizers+' => \$enable_sanitizers,
313 );
314
315 $tesh_file = pop @ARGV;
316 $tesh_name = $tesh_file;
317 $tesh_name =~ s|^.*?/([^/]*)$|$1|;
318
319 print "Enable coverage\n" if ($enable_coverage);
320 print "Enable sanitizers\n" if ($enable_sanitizers);
321
322 if ($diff_tool) {
323     use File::Temp qw/ tempfile /;
324     ( $diff_tool_tmp_fh, $diff_tool_tmp_filename ) = tempfile();
325     print "New tesh: $diff_tool_tmp_filename\n";
326 }
327
328 if ( $tesh_file =~ m/(.*)\.tesh/ ) {
329     print "Test suite `$tesh_file'\n";
330 } else {
331     $tesh_name = "(stdin)";
332     print "Test suite from stdin\n";
333 }
334
335 ###########################################################################
336
337 sub exec_cmd {
338     my %cmd = %{ $_[0] };
339     if ( $opts{'debug'} ) {
340         map { print "IN: $_\n" } @{ $cmd{'in'} };
341         map { print "OUT: $_\n" } @{ $cmd{'out'} };
342         print "CMD: $cmd{'cmd'}\n";
343     }
344
345     # substitute environment variables
346     foreach my $key ( keys %environ ) {
347         $cmd{'cmd'} = var_subst( $cmd{'cmd'}, $key, $environ{$key} );
348     }
349
350     # substitute remaining variables, if any
351     while ( $cmd{'cmd'} =~ /\$\{(\w+)(?::[=-][^}]*)?\}/ ) {
352         $cmd{'cmd'} = var_subst( $cmd{'cmd'}, $1, "" );
353     }
354     while ( $cmd{'cmd'} =~ /\$(\w+)/ ) {
355         $cmd{'cmd'} = var_subst( $cmd{'cmd'}, $1, "" );
356     }
357
358     # add cfg and log options
359     $cmd{'cmd'} .= " $opts{'cfg'}"
360       if ( defined( $opts{'cfg'} ) && length( $opts{'cfg'} ) );
361     $cmd{'cmd'} .= " $opts{'log'}"
362       if ( defined( $opts{'log'} ) && length( $opts{'log'} ) );
363
364     # finally trim any remaining space chars
365     $cmd{'cmd'} =~ s/^\s+//;
366     $cmd{'cmd'} =~ s/\s+$//;
367
368     print "[$tesh_name:$cmd{'line'}] $cmd{'cmd'}\n";
369
370     $cmd{'return'} ||= 0;
371     $cmd{'timeout'} ||= $opts{'timeout'};
372     
373
374     ###
375     # exec the command line
376
377     my @cmdline;
378     if(defined $ENV{VALGRIND_COMMAND}) {
379       push @cmdline, $ENV{VALGRIND_COMMAND};
380       push @cmdline, split(" ", $ENV{VALGRIND_OPTIONS});
381       if($cmd{'timeout'} ne 'no'){
382           $cmd{'timeout'}=$cmd{'timeout'}*20
383       }
384     }
385     push @cmdline, quotewords( '\s+', 0, $cmd{'cmd'} );
386     my $input = defined($cmd{'in'})? join("\n",@{$cmd{'in'}}) : "";
387     my $output = " " x 10240; $output = ""; # Preallocate 10kB, and reset length to 0
388     $cmd{'got'} = \$output;
389     $cmd{'job'} = start \@cmdline, '<', \$input, '>&', \$output, 
390                   ($cmd{'timeout'} eq 'no' ? () : timeout($cmd{'timeout'}));
391
392     if ( $cmd{'background'} ) {
393         # Just enqueue the job. It will be dealed with at the end
394         push @bg_cmds, \%cmd;
395     } else {
396         # Deal with its ending conditions right away
397         analyze_result( \%cmd );
398     }
399 }
400
401 sub analyze_result {
402     my %cmd    = %{ $_[0] };
403     $cmd{'timeouted'} = 0; # initialization
404
405     # Wait for the end of the child process
406     #####
407     eval {
408         finish( $cmd{'job'} );
409     };
410     if ($@) { # deal with the errors that occurred in the child process
411         if ($@ =~ /timeout/) {
412             $cmd{'job'}->kill_kill;
413             $cmd{'timeouted'} = 1;
414         } elsif ($@ =~ /^ack / and $@ =~ /pipe/) { # IPC::Run is not very expressive about the pipes that it gets :(
415             print STDERR "Tesh: Broken pipe (ignored).\n";
416         } else {
417             die $@; # Don't know what it is, so let it go.
418         }
419     } 
420
421     # Gather information
422     ####
423     
424     # pop all output from executing child
425     my @got;
426     map { print "GOT: $_\n" } ${$cmd{'got'}} if $opts{'debug'};
427     foreach my $got ( split("\n", ${$cmd{'got'}}) ) {
428         $got =~ s/\r//g;
429         chomp $got;
430         print $diff_tool_tmp_fh "> $got\n" if ($diff_tool);
431
432         unless (( $enable_coverage and $got =~ /^profiling:/ ) or
433             ( $enable_sanitizers and $got =~ m/WARNING: ASan doesn't fully support/) or
434             ( $got =~ m/Unable to clean temporary file C:/)) # Crude hack to ignore cruft from Java on Windows
435         {
436             push @got, $got;
437         } 
438     }
439
440     # How did the child process terminate?
441     my $status = $?;
442     $cmd{'gotret'} = "Unparsable status. Please report this tesh bug.";
443     if ( $cmd{'timeouted'} ) {
444         $cmd{'gotret'} = "timeout after $cmd{'timeout'} sec";
445         $error    = 1;
446         $exitcode = 3;
447     } elsif ( WIFEXITED($status) ) {
448         $exitcode = WEXITSTATUS($status) + 40;
449         $cmd{'gotret'} = "returned code " . WEXITSTATUS($status);
450     } elsif ( WIFSIGNALED($status) ) {
451         my $code;
452         if    ( WTERMSIG($status) == SIGINT )  { $code = "SIGINT"; }
453         elsif ( WTERMSIG($status) == SIGTERM ) { $code = "SIGTERM"; }
454         elsif ( WTERMSIG($status) == SIGKILL ) { $code = "SIGKILL"; }
455         elsif ( WTERMSIG($status) == SIGABRT ) { $code = "SIGABRT"; }
456         elsif ( WTERMSIG($status) == SIGSEGV ) { $code = "SIGSEGV"; }
457         $exitcode = WTERMSIG($status) + 4;
458         $cmd{'gotret'} = "got signal $code";
459     }
460
461     # How was it supposed to terminate?
462     my $wantret;
463     if ( defined( $cmd{'expect'} ) and ( $cmd{'expect'} ne "" ) ) {
464         $wantret = "got signal $cmd{'expect'}";
465     } else {
466         $wantret = "returned code " . ( defined( $cmd{'return'} ) ? $cmd{'return'} : 0 );
467     }
468
469     # Enforce the outcome
470     ####
471     
472     # Did it end as expected?
473     if ( $cmd{'gotret'} ne $wantret ) {
474         $error = 1;
475         my $msg = "Test suite `$tesh_name': NOK (<$tesh_name:$cmd{'line'}> $cmd{'gotret'})\n";
476         if ( scalar @got ) {
477             $msg = $msg . "Output of <$tesh_name:$cmd{'line'}> so far:\n";
478             map { $msg .= "|| $_\n" } @got;
479         } else {
480             $msg .= "<$tesh_name:$cmd{'line'}> No output so far.\n";
481         }
482         print STDERR "$msg";
483     }
484
485     # Does the output match?
486     if ( $cmd{'sort'} ) {
487         sub mysort {
488             substr( $a, 0, $sort_prefix ) cmp substr( $b, 0, $sort_prefix );
489         }
490         use sort 'stable';
491         if ( $sort_prefix > 0 ) {
492             @got = sort mysort @got;
493         } else {
494             @got = sort @got;
495         }
496         while ( @got and $got[0] eq "" ) {
497             shift @got;
498         }
499
500         # Sort the expected output too, to make tesh files easier to write for humans
501         if ( defined( $cmd{'out'} ) ) {
502             if ( $sort_prefix > 0 ) {
503                 @{ $cmd{'out'} } = sort mysort @{ $cmd{'out'} };
504             } else {
505                 @{ $cmd{'out'} } = sort @{ $cmd{'out'} };
506             }
507             while ( @{ $cmd{'out'} } and ${ $cmd{'out'} }[0] eq "" ) {
508                 shift @{ $cmd{'out'} };
509             }
510         }
511     }
512
513     # Report the output if asked so or if it differs
514     if ( defined( $cmd{'output display'} ) ) {
515         print "[Tesh/INFO] Here is the (ignored) command output:\n";
516         map { print "||$_\n" } @got;
517     } elsif ( defined( $cmd{'output ignore'} ) ) {
518         print "(ignoring the output of <$tesh_name:$cmd{'line'}> as requested)\n";
519     } else {
520         my $diff = build_diff( \@{ $cmd{'out'} }, \@got );
521     
522         if ( length $diff ) {
523             print "Output of <$tesh_name:$cmd{'line'}> mismatch" . ( $cmd{'sort'} ? " (even after sorting)" : "" ) . ":\n";
524             map { print "$_\n" } split( /\n/, $diff );
525             if ( $cmd{'sort'} ) {
526                 print "WARNING: Both the observed output and expected output were sorted as requested.\n";
527                 print "WARNING: Output were only sorted using the $sort_prefix first chars.\n"
528                     if ( $sort_prefix > 0 );
529                 print "WARNING: Use <! output sort 19> to sort by simulated date and process ID only.\n";
530
531                 # print "----8<---------------  Begin of unprocessed observed output (as it should appear in file):\n";
532                 # map {print "> $_\n"} @{$cmd{'unsorted got'}};
533                 # print "--------------->8----  End of the unprocessed observed output.\n";
534             }
535             
536             print "Test suite `$tesh_name': NOK (<$tesh_name:$cmd{'line'}> output mismatch)\n";
537             exit 2;
538         }
539     }
540 }
541
542 # parse tesh file
543 my $infh;    # The file descriptor from which we should read the teshfile
544 if ( $tesh_name eq "(stdin)" ) {
545     $infh = *STDIN;
546 } else {
547     open $infh, $tesh_file
548       or die "[Tesh/CRITICAL] Unable to open $tesh_file: $!\n";
549 }
550
551 my %cmd;     # everything about the next command to run
552 my $line_num = 0;
553 LINE: while ( not $error and defined( my $line = <$infh> )) {
554     chomp $line;
555     $line =~ s/\r//g;
556
557     $line_num++;
558     print "[TESH/debug] $line_num: $line\n" if $opts{'debug'};
559
560     # deal with line continuations
561     while ( $line =~ /^(.*?)\\$/ ) {
562         my $next = <$infh>;
563         die "[TESH/CRITICAL] Continued line at end of file\n"
564           unless defined($next);
565         $line_num++;
566         chomp $next;
567         print "[TESH/debug] $line_num: $next\n" if $opts{'debug'};
568         $line = $1 . $next;
569     }
570
571     # If the line is empty, run any previously defined block and proceed to next line
572     unless ( $line =~ m/^(.)(.*)$/ ) {
573         if ( defined( $cmd{'cmd'} ) ) {
574             exec_cmd( \%cmd );
575             %cmd = ();
576         }
577         print $diff_tool_tmp_fh "$line\n" if ($diff_tool);
578         next LINE;
579     }
580
581     my ( $cmd, $arg ) = ( $1, $2 );
582     print $diff_tool_tmp_fh "$line\n" if ( $diff_tool and $cmd ne '>' );
583     $arg =~ s/^ //g;
584     $arg =~ s/\r//g;
585     $arg =~ s/\\\\/\\/g;
586
587     # Deal with the lines that can contribute to the current command block
588     if ( $cmd =~ /^#/ ) {    # comment
589         next LINE;
590     } elsif ( $cmd eq '>' ) {    # expected result line
591         print "[TESH/debug] push expected result\n" if $opts{'debug'};
592         push @{ $cmd{'out'} }, $arg;
593         next LINE;
594
595     } elsif ( $cmd eq '<' ) {    # provided input
596         print "[TESH/debug] push provided input\n" if $opts{'debug'};
597         push @{ $cmd{'in'} }, $arg;
598         next LINE;
599
600     } elsif ( $cmd eq 'p' ) {    # comment
601         print "[$tesh_name:$line_num] $arg\n";
602         next LINE;
603
604     } 
605
606     # We dealt with all sort of lines that can contribute to a command block, so we have something else here.
607     # If we have something buffered, run it now and start a new block
608     if ( defined( $cmd{'cmd'} ) ) {
609         exec_cmd( \%cmd );
610         %cmd = ();
611     }
612
613     # Deal with the lines that must be placed before a command block
614     if ( $cmd eq '$' ) {    # Command
615         if ( $arg =~ /^mkfile / ) {    # "mkfile" command line
616             die "[TESH/CRITICAL] Output expected from mkfile command!\n"
617               if scalar @{ cmd { 'out' } };
618
619             $cmd{'arg'} = $arg;
620             $cmd{'arg'} =~ s/mkfile //;
621             mkfile_cmd( \%cmd );
622             %cmd = ();
623
624         } elsif ( $arg =~ /^\s*cd / ) {
625             die "[TESH/CRITICAL] Input provided to cd command!\n"
626               if scalar @{ cmd { 'in' } };
627             die "[TESH/CRITICAL] Output expected from cd command!\n"
628               if scalar @{ cmd { 'out' } };
629
630             $arg =~ s/^ *cd //;
631             cd_cmd($arg);
632             %cmd = ();
633
634         } else {    # regular command
635             $cmd{'cmd'}  = $arg;
636             $cmd{'line'} = $line_num;
637         }
638
639     } elsif ( $cmd eq '&' ) {    # background command line
640         die "[TESH/CRITICAL] mkfile cannot be run in background\n"
641             if ($arg =~ /^mkfile/);
642         die "[TESH/CRITICAL] cd cannot be run in background\n"
643             if ($arg =~ /^cd/);
644         
645         $cmd{'background'} = 1;
646         $cmd{'cmd'}        = $arg;
647         $cmd{'line'}       = $line_num;
648
649     # Deal with the meta-commands
650     } elsif ( $line =~ /^! (.*)/) {
651         $line = $1;
652
653         if ( $line =~ /^output sort/ ) {
654             $cmd{'sort'} = 1;
655             if ( $line =~ /^output sort\s+(\d+)/ ) {
656                 $sort_prefix = $1;
657             }
658         } elsif ($line =~ /^output ignore/ ) {
659             $cmd{'output ignore'} = 1;
660         } elsif ( $line =~ /^output display/ ) {
661             $cmd{'output display'} = 1;
662         } elsif ( $line =~ /^expect signal (\w*)/ ) {
663             $cmd{'expect'} = $1;
664         } elsif ( $line =~ /^expect return/ ) {
665             $line =~ s/^expect return //g;
666             $line =~ s/\r//g;
667             $cmd{'return'} = $line;
668         } elsif ( $line =~ /^setenv/ ) {
669             $line =~ s/^setenv //g;
670             $line =~ s/\r//g;
671             setenv_cmd($line);
672         } elsif ( $line =~ /^timeout/ ) {
673             $line =~ s/^timeout //;
674             $line =~ s/\r//g;
675             $cmd{'timeout'} = $line;
676         }
677     } else {
678         die "[TESH/CRITICAL] parse error: $line\n";
679     }
680 }
681
682 # We are done reading the input file
683 close $infh unless ( $tesh_name eq "(stdin)" );
684
685 # Deal with last command, if any
686 if ( defined( $cmd{'cmd'} ) ) {
687     exec_cmd( \%cmd );
688     %cmd = ();
689 }
690
691 foreach (@bg_cmds) {
692     my %test = %{$_};
693     analyze_result( \%test );
694 }
695
696 if ($diff_tool) {
697     close $diff_tool_tmp_fh;
698     system("$diff_tool $diff_tool_tmp_filename $tesh_file");
699     unlink $diff_tool_tmp_filename;
700 }
701
702 if ( $error != 0 ) {
703     exit $exitcode;
704 } elsif ( $tesh_name eq "(stdin)" ) {
705     print "Test suite from stdin OK\n";
706 } else {
707     print "Test suite `$tesh_name' OK\n";
708 }
709
710 exit 0;
711
712 ####
713 #### Helper functions
714 ####
715
716 sub build_diff {
717     my $res;
718     my $diff = Diff->new(@_);
719
720     $diff->Base(1);    # Return line numbers, not indices
721     my $chunk_count = $diff->Next(-1);    # Compute the amount of chuncks
722     return "" if ( $chunk_count == 1 && $diff->Same() );
723     $diff->Reset();
724     while ( $diff->Next() ) {
725         my @same = $diff->Same();
726         if ( $diff->Same() ) {
727             if ( $diff->Next(0) > 1 ) {    # not first chunk: print 2 first lines
728                 $res .= '  ' . $same[0] . "\n";
729                 $res .= '  ' . $same[1] . "\n" if ( scalar @same > 1 );
730             }
731             $res .= "...\n" if ( scalar @same > 2 );
732
733             #    $res .= $diff->Next(0)."/$chunk_count\n";
734             if ( $diff->Next(0) < $chunk_count ) {    # not last chunk: print 2 last lines
735                 $res .= '  ' . $same[ scalar @same - 2 ] . "\n"
736                   if ( scalar @same > 1 );
737                 $res .= '  ' . $same[ scalar @same - 1 ] . "\n";
738             }
739         }
740         next if $diff->Same();
741         map { $res .= "- $_\n" } $diff->Items(1);
742         map { $res .= "+ $_\n" } $diff->Items(2);
743     }
744     return $res;
745 }
746
747 # Helper function replacing any occurence of variable '$name' by its '$value'
748 # As in Bash, ${$value:=BLABLA} is rewritten to $value if set or to BLABLA if $value is not set
749 sub var_subst {
750     my ( $text, $name, $value ) = @_;
751     if ($value) {
752         $text =~ s/\$\{$name(?::[=-][^}]*)?\}/$value/g;
753         $text =~ s/\$$name(\W|$)/$value$1/g;
754     } else {
755         $text =~ s/\$\{$name:=([^}]*)\}/$1/g;
756         $text =~ s/\$\{$name\}//g;
757         $text =~ s/\$$name(\W|$)/$1/g;
758     }
759     return $text;
760 }
761
762 ################################  The possible commands  ################################
763
764 sub mkfile_cmd($) {
765     my %cmd  = %{ $_[0] };
766     my $file = $cmd{'arg'};
767     print STDERR "[Tesh/INFO] mkfile $file. Ctn: >>".join( '\n', @{ $cmd{'in'} })."<<\n"
768       if $opts{'debug'};
769
770     unlink($file);
771     open( FILE, ">$file" )
772       or die "[Tesh/CRITICAL] Unable to create file $file: $!\n";
773     print FILE join( "\n", @{ $cmd{'in'} } );
774     print FILE "\n" if ( scalar @{ $cmd{'in'} } > 0 );
775     close(FILE);
776 }
777
778 # Command CD. Just change to the provided directory
779 sub cd_cmd($) {
780     my $directory = shift;
781     my $failure   = 1;
782     if ( -e $directory && -d $directory ) {
783         chdir("$directory");
784         print "[Tesh/INFO] change directory to $directory\n";
785         $failure = 0;
786     } elsif ( -e $directory ) {
787         print "Cannot change directory to '$directory': it is not a directory\n";
788     } else {
789         print "Chdir to $directory failed: No such file or directory\n";
790     }
791     if ( $failure == 1 ) {
792         print "Test suite `$tesh_name': NOK (system error)\n";
793         exit 4;
794     }
795 }
796
797 # Command setenv. Gets "variable=content", and update the environment accordingly
798 sub setenv_cmd($) {
799     my $arg = shift;
800     if ( $arg =~ /^(.*?)=(.*)$/ ) {
801         my ( $var, $ctn ) = ( $1, $2 );
802         print "[Tesh/INFO] setenv $var=$ctn\n";
803         $environ{$var} = $ctn;
804         $ENV{$var} = $ctn;
805     } else {
806         die "[Tesh/CRITICAL] Malformed argument to setenv: expected 'name=value' but got '$arg'\n";
807     }
808 }