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     my $fullname = $tesh_file;
 330     if (not ($fullname =~ m|^/|)) { # not absolute path
 331         my $dir = qx,pwd,;
 332         chomp($dir);
 333         $fullname = "$dir/$fullname"
 334     }
 335     print "Test suite '$tesh_file'\n";
 336 } else {
 337     $tesh_name = "(stdin)";
 338     print "Test suite from stdin\n";
 339 }
 340
 341 ###########################################################################
 342
 343 sub exec_cmd {
 344     my %cmd = %{ $_[0] };
 345     if ( $opts{'debug'} ) {
 346         map { print "IN: $_\n" } @{ $cmd{'in'} };
 347         map { print "OUT: $_\n" } @{ $cmd{'out'} };
 348         print "CMD: $cmd{'cmd'}\n";
 349     }
 350
 351     # substitute environment variables
 352     foreach my $key ( keys %environ ) {
 353         $cmd{'cmd'} = var_subst( $cmd{'cmd'}, $key, $environ{$key} );
 354     }
 355
 356     # substitute remaining variables, if any
 357     while ( $cmd{'cmd'} =~ /\$\{(\w+)(?::[=-][^}]*)?\}/ ) {
 358         $cmd{'cmd'} = var_subst( $cmd{'cmd'}, $1, "" );
 359     }
 360     while ( $cmd{'cmd'} =~ /\$(\w+)/ ) {
 361         $cmd{'cmd'} = var_subst( $cmd{'cmd'}, $1, "" );
 362     }
 363
 364     # add cfg and log options
 365     $cmd{'cmd'} .= " $opts{'cfg'}"
 366       if ( defined( $opts{'cfg'} ) && length( $opts{'cfg'} ) );
 367     $cmd{'cmd'} .= " $opts{'log'}"
 368       if ( defined( $opts{'log'} ) && length( $opts{'log'} ) );
 369
 370     # finally trim any remaining space chars
 371     $cmd{'cmd'} =~ s/^\s+//;
 372     $cmd{'cmd'} =~ s/\s+$//;
 373
 374     print "[$tesh_name:$cmd{'line'}] $cmd{'cmd'}\n";
 375
 376     $cmd{'return'} ||= 0;
 377     $cmd{'timeout'} ||= $opts{'timeout'};
 378
 379
 380     ###
 381     # exec the command line
 382
 383     my @cmdline;
 384     if(defined $ENV{VALGRIND_COMMAND}) {
 385       push @cmdline, $ENV{VALGRIND_COMMAND};
 386       push @cmdline, split(" ", $ENV{VALGRIND_OPTIONS});
 387       if($cmd{'timeout'} ne 'no'){
 388           $cmd{'timeout'}=$cmd{'timeout'}*20
 389       }
 390     }
 391     push @cmdline, quotewords( '\s+', 0, $cmd{'cmd'} );
 392     my $input = defined($cmd{'in'})? join("\n",@{$cmd{'in'}}) : "";
 393     my $output = " " x 10240; $output = ""; # Preallocate 10kB, and reset length to 0
 394     $cmd{'got'} = \$output;
 395     $cmd{'job'} = start \@cmdline, '<', \$input, '>&', \$output,
 396                   ($cmd{'timeout'} eq 'no' ? () : timeout($cmd{'timeout'}));
 397
 398     if ( $cmd{'background'} ) {
 399         # Just enqueue the job. It will be dealed with at the end
 400         push @bg_cmds, \%cmd;
 401     } else {
 402         # Deal with its ending conditions right away
 403         analyze_result( \%cmd );
 404     }
 405 }
 406
 407 sub analyze_result {
 408     my %cmd    = %{ $_[0] };
 409     $cmd{'timeouted'} = 0; # initialization
 410
 411     # Wait for the end of the child process
 412     #####
 413     eval {
 414         finish( $cmd{'job'} );
 415     };
 416     if ($@) { # deal with the errors that occurred in the child process
 417         if ($@ =~ /timeout/) {
 418             $cmd{'job'}->kill_kill;
 419             $cmd{'timeouted'} = 1;
 420         } elsif ($@ =~ /^ack / and $@ =~ /pipe/) { # IPC::Run is not very expressive about the pipes that it gets :(
 421             print STDERR "Tesh: Broken pipe (ignored).\n";
 422         } else {
 423             die $@; # Don't know what it is, so let it go.
 424         }
 425     }
 426
 427     # Gather information
 428     ####
 429
 430     # pop all output from executing child
 431     my @got;
 432     map { print "GOT: $_\n" } ${$cmd{'got'}} if $opts{'debug'};
 433     foreach my $got ( split("\n", ${$cmd{'got'}}) ) {
 434         $got =~ s/\r//g;
 435         chomp $got;
 436         print $diff_tool_tmp_fh "> $got\n" if ($diff_tool);
 437
 438         unless (( $enable_coverage and $got =~ /^profiling:/ ) or
 439             ( $enable_sanitizers and $got =~ m/WARNING: ASan doesn't fully support/) or
 440             ( $got =~ m/Unable to clean temporary file C:/)) # Crude hack to ignore cruft from Java on Windows
 441         {
 442             push @got, $got;
 443         }
 444     }
 445
 446     # How did the child process terminate?
 447     my $status = $?;
 448     $cmd{'gotret'} = "Unparsable status. Please report this tesh bug.";
 449     if ( $cmd{'timeouted'} ) {
 450         $cmd{'gotret'} = "timeout after $cmd{'timeout'} sec";
 451         $error    = 1;
 452         $exitcode = 3;
 453     } elsif ( WIFEXITED($status) ) {
 454         $exitcode = WEXITSTATUS($status) + 40;
 455         $cmd{'gotret'} = "returned code " . WEXITSTATUS($status);
 456     } elsif ( WIFSIGNALED($status) ) {
 457         my $code;
 458         if    ( WTERMSIG($status) == SIGINT )  { $code = "SIGINT"; }
 459         elsif ( WTERMSIG($status) == SIGTERM ) { $code = "SIGTERM"; }
 460         elsif ( WTERMSIG($status) == SIGKILL ) { $code = "SIGKILL"; }
 461         elsif ( WTERMSIG($status) == SIGABRT ) { $code = "SIGABRT"; }
 462         elsif ( WTERMSIG($status) == SIGSEGV ) { $code = "SIGSEGV"; }
 463         $exitcode = WTERMSIG($status) + 4;
 464         $cmd{'gotret'} = "got signal $code";
 465     }
 466
 467     # How was it supposed to terminate?
 468     my $wantret;
 469     if ( defined( $cmd{'expect'} ) and ( $cmd{'expect'} ne "" ) ) {
 470         $wantret = "got signal $cmd{'expect'}";
 471     } else {
 472         $wantret = "returned code " . ( defined( $cmd{'return'} ) ? $cmd{'return'} : 0 );
 473     }
 474
 475     # Enforce the outcome
 476     ####
 477
 478     # Did it end as expected?
 479     if ( $cmd{'gotret'} ne $wantret ) {
 480         $error = 1;
 481         my $msg = "Test suite `$tesh_name': NOK (<$tesh_name:$cmd{'line'}> $cmd{'gotret'})\n";
 482         if ( scalar @got ) {
 483             $msg = $msg . "Output of <$tesh_name:$cmd{'line'}> so far:\n";
 484             map { $msg .= "|| $_\n" } @got;
 485         } else {
 486             $msg .= "<$tesh_name:$cmd{'line'}> No output so far.\n";
 487         }
 488         print STDERR "$msg";
 489     }
 490
 491     # Does the output match?
 492     if ( $cmd{'sort'} ) {
 493         sub mysort {
 494             substr( $a, 0, $sort_prefix ) cmp substr( $b, 0, $sort_prefix );
 495         }
 496         use sort 'stable';
 497         if ( $sort_prefix > 0 ) {
 498             @got = sort mysort @got;
 499         } else {
 500             @got = sort @got;
 501         }
 502         while ( @got and $got[0] eq "" ) {
 503             shift @got;
 504         }
 505
 506         # Sort the expected output too, to make tesh files easier to write for humans
 507         if ( defined( $cmd{'out'} ) ) {
 508             if ( $sort_prefix > 0 ) {
 509                 @{ $cmd{'out'} } = sort mysort @{ $cmd{'out'} };
 510             } else {
 511                 @{ $cmd{'out'} } = sort @{ $cmd{'out'} };
 512             }
 513             while ( @{ $cmd{'out'} } and ${ $cmd{'out'} }[0] eq "" ) {
 514                 shift @{ $cmd{'out'} };
 515             }
 516         }
 517     }
 518
 519     # Report the output if asked so or if it differs
 520     if ( defined( $cmd{'output display'} ) ) {
 521         print "[Tesh/INFO] Here is the (ignored) command output:\n";
 522         map { print "||$_\n" } @got;
 523     } elsif ( defined( $cmd{'output ignore'} ) ) {
 524         print "(ignoring the output of <$tesh_name:$cmd{'line'}> as requested)\n";
 525     } else {
 526         my $diff = build_diff( \@{ $cmd{'out'} }, \@got );
 527
 528         if ( length $diff ) {
 529             print "Output of <$tesh_name:$cmd{'line'}> mismatch" . ( $cmd{'sort'} ? " (even after sorting)" : "" ) . ":\n";
 530             map { print "$_\n" } split( /\n/, $diff );
 531             if ( $cmd{'sort'} ) {
 532                 print "WARNING: Both the observed output and expected output were sorted as requested.\n";
 533                 print "WARNING: Output were only sorted using the $sort_prefix first chars.\n"
 534                     if ( $sort_prefix > 0 );
 535                 print "WARNING: Use <! output sort 19> to sort by simulated date and process ID only.\n";
 536
 537                 # print "----8<---------------  Begin of unprocessed observed output (as it should appear in file):\n";
 538                 # map {print "> $_\n"} @{$cmd{'unsorted got'}};
 539                 # print "--------------->8----  End of the unprocessed observed output.\n";
 540             }
 541
 542             print "Test suite `$tesh_name': NOK (<$tesh_name:$cmd{'line'}> output mismatch)\n";
 543             exit 2;
 544         }
 545     }
 546 }
 547
 548 # parse tesh file
 549 my $infh;    # The file descriptor from which we should read the teshfile
 550 if ( $tesh_name eq "(stdin)" ) {
 551     $infh = *STDIN;
 552 } else {
 553     open $infh, $tesh_file
 554       or die "[Tesh/CRITICAL] Unable to open $tesh_file: $!\n";
 555 }
 556
 557 my %cmd;     # everything about the next command to run
 558 my $line_num = 0;
 559 LINE: while ( not $error and defined( my $line = <$infh> )) {
 560     chomp $line;
 561     $line =~ s/\r//g;
 562
 563     $line_num++;
 564     print "[TESH/debug] $line_num: $line\n" if $opts{'debug'};
 565
 566     # deal with line continuations
 567     while ( $line =~ /^(.*?)\\$/ ) {
 568         my $next = <$infh>;
 569         die "[TESH/CRITICAL] Continued line at end of file\n"
 570           unless defined($next);
 571         $line_num++;
 572         chomp $next;
 573         print "[TESH/debug] $line_num: $next\n" if $opts{'debug'};
 574         $line = $1 . $next;
 575     }
 576
 577     # If the line is empty, run any previously defined block and proceed to next line
 578     unless ( $line =~ m/^(.)(.*)$/ ) {
 579         if ( defined( $cmd{'cmd'} ) ) {
 580             exec_cmd( \%cmd );
 581             %cmd = ();
 582         }
 583         print $diff_tool_tmp_fh "$line\n" if ($diff_tool);
 584         next LINE;
 585     }
 586
 587     my ( $cmd, $arg ) = ( $1, $2 );
 588     print $diff_tool_tmp_fh "$line\n" if ( $diff_tool and $cmd ne '>' );
 589     $arg =~ s/^ //g;
 590     $arg =~ s/\r//g;
 591     $arg =~ s/\\\\/\\/g;
 592
 593     # Deal with the lines that can contribute to the current command block
 594     if ( $cmd =~ /^#/ ) {    # comment
 595         next LINE;
 596     } elsif ( $cmd eq '>' ) {    # expected result line
 597         print "[TESH/debug] push expected result\n" if $opts{'debug'};
 598         push @{ $cmd{'out'} }, $arg;
 599         next LINE;
 600
 601     } elsif ( $cmd eq '<' ) {    # provided input
 602         print "[TESH/debug] push provided input\n" if $opts{'debug'};
 603         push @{ $cmd{'in'} }, $arg;
 604         next LINE;
 605
 606     } elsif ( $cmd eq 'p' ) {    # comment
 607         print "[$tesh_name:$line_num] $arg\n";
 608         next LINE;
 609
 610     }
 611
 612     # We dealt with all sort of lines that can contribute to a command block, so we have something else here.
 613     # If we have something buffered, run it now and start a new block
 614     if ( defined( $cmd{'cmd'} ) ) {
 615         exec_cmd( \%cmd );
 616         %cmd = ();
 617     }
 618
 619     # Deal with the lines that must be placed before a command block
 620     if ( $cmd eq '$' ) {    # Command
 621         if ( $arg =~ /^mkfile / ) {    # "mkfile" command line
 622             die "[TESH/CRITICAL] Output expected from mkfile command!\n"
 623               if scalar @{ cmd { 'out' } };
 624
 625             $cmd{'arg'} = $arg;
 626             $cmd{'arg'} =~ s/mkfile //;
 627             mkfile_cmd( \%cmd );
 628             %cmd = ();
 629
 630         } elsif ( $arg =~ /^\s*cd / ) {
 631             die "[TESH/CRITICAL] Input provided to cd command!\n"
 632               if scalar @{ cmd { 'in' } };
 633             die "[TESH/CRITICAL] Output expected from cd command!\n"
 634               if scalar @{ cmd { 'out' } };
 635
 636             $arg =~ s/^ *cd //;
 637             cd_cmd($arg);
 638             %cmd = ();
 639
 640         } else {    # regular command
 641             $cmd{'cmd'}  = $arg;
 642             $cmd{'line'} = $line_num;
 643         }
 644
 645     } elsif ( $cmd eq '&' ) {    # background command line
 646         die "[TESH/CRITICAL] mkfile cannot be run in background\n"
 647             if ($arg =~ /^mkfile/);
 648         die "[TESH/CRITICAL] cd cannot be run in background\n"
 649             if ($arg =~ /^cd/);
 650
 651         $cmd{'background'} = 1;
 652         $cmd{'cmd'}        = $arg;
 653         $cmd{'line'}       = $line_num;
 654
 655     # Deal with the meta-commands
 656     } elsif ( $line =~ /^! (.*)/) {
 657         $line = $1;
 658
 659         if ( $line =~ /^output sort/ ) {
 660             $cmd{'sort'} = 1;
 661             if ( $line =~ /^output sort\s+(\d+)/ ) {
 662                 $sort_prefix = $1;
 663             }
 664         } elsif ($line =~ /^output ignore/ ) {
 665             $cmd{'output ignore'} = 1;
 666         } elsif ( $line =~ /^output display/ ) {
 667             $cmd{'output display'} = 1;
 668         } elsif ( $line =~ /^expect signal (\w*)/ ) {
 669             $cmd{'expect'} = $1;
 670         } elsif ( $line =~ /^expect return/ ) {
 671             $line =~ s/^expect return //g;
 672             $line =~ s/\r//g;
 673             $cmd{'return'} = $line;
 674         } elsif ( $line =~ /^setenv/ ) {
 675             $line =~ s/^setenv //g;
 676             $line =~ s/\r//g;
 677             setenv_cmd($line);
 678         } elsif ( $line =~ /^timeout/ ) {
 679             $line =~ s/^timeout //;
 680             $line =~ s/\r//g;
 681             $cmd{'timeout'} = $line;
 682         }
 683     } else {
 684         die "[TESH/CRITICAL] parse error: $line\n";
 685     }
 686 }
 687
 688 # We are done reading the input file
 689 close $infh unless ( $tesh_name eq "(stdin)" );
 690
 691 # Deal with last command, if any
 692 if ( defined( $cmd{'cmd'} ) ) {
 693     exec_cmd( \%cmd );
 694     %cmd = ();
 695 }
 696
 697 foreach (@bg_cmds) {
 698     my %test = %{$_};
 699     analyze_result( \%test );
 700 }
 701
 702 if ($diff_tool) {
 703     close $diff_tool_tmp_fh;
 704     system("$diff_tool $diff_tool_tmp_filename $tesh_file");
 705     unlink $diff_tool_tmp_filename;
 706 }
 707
 708 if ( $error != 0 ) {
 709     exit $exitcode;
 710 } elsif ( $tesh_name eq "(stdin)" ) {
 711     print "Test suite from stdin OK\n";
 712 } else {
 713     print "Test suite `$tesh_name' OK\n";
 714 }
 715
 716 exit 0;
 717
 718 ####
 719 #### Helper functions
 720 ####
 721
 722 sub build_diff {
 723     my $res;
 724     my $diff = Diff->new(@_);
 725
 726     $diff->Base(1);    # Return line numbers, not indices
 727     my $chunk_count = $diff->Next(-1);    # Compute the amount of chuncks
 728     return "" if ( $chunk_count == 1 && $diff->Same() );
 729     $diff->Reset();
 730     while ( $diff->Next() ) {
 731         my @same = $diff->Same();
 732         if ( $diff->Same() ) {
 733             if ( $diff->Next(0) > 1 ) {    # not first chunk: print 2 first lines
 734                 $res .= '  ' . $same[0] . "\n";
 735                 $res .= '  ' . $same[1] . "\n" if ( scalar @same > 1 );
 736             }
 737             $res .= "...\n" if ( scalar @same > 2 );
 738
 739             #    $res .= $diff->Next(0)."/$chunk_count\n";
 740             if ( $diff->Next(0) < $chunk_count ) {    # not last chunk: print 2 last lines
 741                 $res .= '  ' . $same[ scalar @same - 2 ] . "\n"
 742                   if ( scalar @same > 1 );
 743                 $res .= '  ' . $same[ scalar @same - 1 ] . "\n";
 744             }
 745         }
 746         next if $diff->Same();
 747         map { $res .= "- $_\n" } $diff->Items(1);
 748         map { $res .= "+ $_\n" } $diff->Items(2);
 749     }
 750     return $res;
 751 }
 752
 753 # Helper function replacing any occurence of variable '$name' by its '$value'
 754 # As in Bash, ${$value:=BLABLA} is rewritten to $value if set or to BLABLA if $value is not set
 755 sub var_subst {
 756     my ( $text, $name, $value ) = @_;
 757     if ($value) {
 758         $text =~ s/\$\{$name(?::[=-][^}]*)?\}/$value/g;
 759         $text =~ s/\$$name(\W|$)/$value$1/g;
 760     } else {
 761         $text =~ s/\$\{$name:=([^}]*)\}/$1/g;
 762         $text =~ s/\$\{$name\}//g;
 763         $text =~ s/\$$name(\W|$)/$1/g;
 764     }
 765     return $text;
 766 }
 767
 768 ################################  The possible commands  ################################
 769
 770 sub mkfile_cmd($) {
 771     my %cmd  = %{ $_[0] };
 772     my $file = $cmd{'arg'};
 773     print STDERR "[Tesh/INFO] mkfile $file. Ctn: >>".join( '\n', @{ $cmd{'in'} })."<<\n"
 774       if $opts{'debug'};
 775
 776     unlink($file);
 777     open( FILE, ">$file" )
 778       or die "[Tesh/CRITICAL] Unable to create file $file: $!\n";
 779     print FILE join( "\n", @{ $cmd{'in'} } );
 780     print FILE "\n" if ( scalar @{ $cmd{'in'} } > 0 );
 781     close(FILE);
 782 }
 783
 784 # Command CD. Just change to the provided directory
 785 sub cd_cmd($) {
 786     my $directory = shift;
 787     my $failure   = 1;
 788     if ( -e $directory && -d $directory ) {
 789         chdir("$directory");
 790         print "[Tesh/INFO] change directory to $directory\n";
 791         $failure = 0;
 792     } elsif ( -e $directory ) {
 793         print "Cannot change directory to '$directory': it is not a directory\n";
 794     } else {
 795         print "Chdir to $directory failed: No such file or directory\n";
 796     }
 797     if ( $failure == 1 ) {
 798         print "Test suite `$tesh_name': NOK (system error)\n";
 799         exit 4;
 800     }
 801 }
 802
 803 # Command setenv. Gets "variable=content", and update the environment accordingly
 804 sub setenv_cmd($) {
 805     my $arg = shift;
 806     if ( $arg =~ /^(.*?)=(.*)$/ ) {
 807         my ( $var, $ctn ) = ( $1, $2 );
 808         print "[Tesh/INFO] setenv $var=$ctn\n";
 809         $environ{$var} = $ctn;
 810         $ENV{$var} = $ctn;
 811     } else {
 812         die "[Tesh/CRITICAL] Malformed argument to setenv: expected 'name=value' but got '$arg'\n";
 813     }
 814 }