Logo AND Algorithmique Numérique Distribuée

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