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 AND LIMITATIONS
 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 =cut
 230
 231 BEGIN {
 232     # Disabling IPC::Run::Debug saves tons of useless calls.
 233     $ENV{'IPCRUNDEBUG'} = 'none'
 234       unless exists $ENV{'IPCRUNDEBUG'};
 235 }
 236
 237 my $enable_coverage        = 0;
 238 my $diff_tool              = 0;
 239 my $diff_tool_tmp_fh       = 0;
 240 my $diff_tool_tmp_filename = 0;
 241 my $sort_prefix            = -1;
 242 my $tesh_file;
 243 my $tesh_name;
 244 my $error    = 0;
 245 my $exitcode = 0;
 246 my @bg_cmds;
 247 my (%environ);
 248 $SIG{'PIPE'} = 'IGNORE';
 249
 250 my $path = $0;
 251 $path =~ s|[^/]*$||;
 252 push @INC, $path;
 253
 254 use lib "@CMAKE_BINARY_DIR@/bin";
 255
 256 use Diff qw(diff);    # postpone a bit to have time to change INC
 257
 258 use Getopt::Long qw(GetOptions);
 259 use strict;
 260 use Text::ParseWords;
 261 use IPC::Run qw(start run timeout finish);
 262 use IO::File;
 263 use English;
 264
 265 ####
 266 #### Portability bits for windows
 267 ####
 268
 269 use constant RUNNING_ON_WINDOWS => ( $OSNAME =~ /^(?:mswin|dos|os2)/oi );
 270 use POSIX qw(:sys_wait_h WIFEXITED WIFSIGNALED WIFSTOPPED WEXITSTATUS WTERMSIG WSTOPSIG
 271   :signal_h SIGINT SIGTERM SIGKILL SIGABRT SIGSEGV);
 272
 273 BEGIN {
 274     if (RUNNING_ON_WINDOWS) { # Missing on windows
 275         *WIFEXITED   = sub { not $_[0] & 127 };
 276         *WEXITSTATUS = sub { $_[0] >> 8 };
 277         *WIFSIGNALED = sub { ( $_[0] & 127 ) && ( $_[0] & 127 != 127 ) };
 278         *WTERMSIG    = sub { $_[0] & 127 };
 279     }
 280 }
 281
 282
 283 ####
 284 #### Command line option handling
 285 ####
 286
 287 my %opts = ( "debug" => 0,
 288              "timeout" => 5, # No command should run any longer than 5 seconds by default
 289            );
 290
 291 Getopt::Long::config( 'bundling', 'no_getopt_compat', 'no_auto_abbrev' );
 292 GetOptions(
 293     'debug|d' => \$opts{"debug"},
 294
 295     'difftool=s' => \$diff_tool,
 296
 297     'cd=s'      => sub { cd_cmd( $_[1] ) },
 298     'timeout=s' => \$opts{'timeout'},
 299     'setenv=s'  => sub { setenv_cmd( $_[1] ) },
 300     'cfg=s' => sub { $opts{'cfg'} .= " --cfg=$_[1]" },
 301     'enable-coverage+' => \$enable_coverage,
 302 );
 303
 304 $tesh_file = pop @ARGV;
 305
 306 print "Enable coverage\n" if ($enable_coverage);
 307
 308 if ($diff_tool) {
 309     use File::Temp qw/ tempfile /;
 310     ( $diff_tool_tmp_fh, $diff_tool_tmp_filename ) = tempfile();
 311     print "New tesh: $diff_tool_tmp_filename\n";
 312 }
 313
 314 if ( $tesh_file =~ m/(.*)\.tesh/ ) {
 315     $tesh_name = $1;
 316     print "Test suite `$tesh_name'\n";
 317 } else {
 318     $tesh_file = "(stdin)";
 319     $tesh_name = "(stdin)";
 320     print "Test suite from stdin\n";
 321 }
 322
 323 ###########################################################################
 324
 325 sub exit_status {
 326     my $status = shift;
 327     if ( WIFEXITED($status) ) {
 328         $exitcode = WEXITSTATUS($status) + 40;
 329         return "returned code " . WEXITSTATUS($status);
 330     } elsif ( WIFSIGNALED($status) ) {
 331         my $code;
 332         if    ( WTERMSIG($status) == SIGINT )  { $code = "SIGINT"; }
 333         elsif ( WTERMSIG($status) == SIGTERM ) { $code = "SIGTERM"; }
 334         elsif ( WTERMSIG($status) == SIGKILL ) { $code = "SIGKILL"; }
 335         elsif ( WTERMSIG($status) == SIGABRT ) { $code = "SIGABRT"; }
 336         elsif ( WTERMSIG($status) == SIGSEGV ) { $code = "SIGSEGV"; }
 337         $exitcode = WTERMSIG($status) + 4;
 338         return "got signal $code";
 339     }
 340     return "Unparsable status. Is the process stopped?";
 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     # cleanup the command line
 352     if (RUNNING_ON_WINDOWS) {
 353         var_subst( $cmd{'cmd'}, "EXEEXT", ".exe" );
 354     } else {
 355         var_subst( $cmd{'cmd'}, "EXEEXT", "" );
 356     }
 357
 358     # substitute environ variables
 359     foreach my $key ( keys %environ ) {
 360         $cmd{'cmd'} = var_subst( $cmd{'cmd'}, $key, $environ{$key} );
 361     }
 362
 363     # substitute remaining variables, if any
 364     while ( $cmd{'cmd'} =~ /\${(\w+)(?::[=-][^}]*)?}/ ) {
 365         $cmd{'cmd'} = var_subst( $cmd{'cmd'}, $1, "" );
 366     }
 367     while ( $cmd{'cmd'} =~ /\$(\w+)/ ) {
 368         $cmd{'cmd'} = var_subst( $cmd{'cmd'}, $1, "" );
 369     }
 370
 371     # add cfg options
 372     $cmd{'cmd'} .= " $opts{'cfg'}"
 373       if ( defined( $opts{'cfg'} ) && length( $opts{'cfg'} ) );
 374
 375     # finally trim any remaining space chars
 376     $cmd{'cmd'} =~ s/^\s+//;
 377     $cmd{'cmd'} =~ s/\s+$//;
 378
 379     print "[$tesh_name:$cmd{'line'}] $cmd{'cmd'}\n";
 380
 381     $cmd{'return'} ||= 0;
 382     $cmd{'timeout'} ||= $opts{'timeout'};
 383
 384
 385     ###
 386     # exec the command line
 387
 388     my @cmdline = quotewords( '\s+', 0, $cmd{'cmd'} );
 389     my $input = defined($cmd{'in'})? join("\n",@{$cmd{'in'}}) : "";
 390     my $output = " " x 10240; $output = ""; # Preallocate 10kB, and reset length to 0
 391     $cmd{'got'} = \$output;
 392     $cmd{'job'} = start \@cmdline, '<', \$input, '>&', \$output,
 393                   ($cmd{'timeout'} eq 'no' ? () : timeout($cmd{'timeout'}));
 394
 395     if ( $cmd{'background'} ) {
 396         # Just enqueue the job. It will be dealed with at the end
 397         push @bg_cmds, \%cmd;
 398     } else {
 399         # Deal with its ending conditions right away
 400         analyze_result( \%cmd );
 401     }
 402 }
 403
 404 sub analyze_result {
 405     my %cmd    = %{ $_[0] };
 406
 407     eval {
 408         finish( $cmd{'job'} );
 409     };
 410     if ($@) {
 411         if ($@ =~ /timeout/) {
 412             $cmd{'job'}->kill_kill;
 413             $cmd{'timeouted'} = 1;
 414         } elsif ($@ =~ /^ack / and $@ =~ /pipe/) {
 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     $cmd{'timeouted'} ||= 0;
 421
 422     my $gotret = $cmd{'gotret'} = exit_status($?);
 423
 424     my $wantret;
 425
 426     if ( defined( $cmd{'expect'} ) and ( $cmd{'expect'} ne "" ) ) {
 427         $wantret = "got signal $cmd{'expect'}";
 428     } else {
 429         $wantret = "returned code " . ( defined( $cmd{'return'} ) ? $cmd{'return'} : 0 );
 430     }
 431
 432     # pop all output from executing child
 433     my @got;
 434     map { print "GOT: $_\n" } ${$cmd{'got'}} if $opts{'debug'};
 435     foreach my $got ( split("\n", ${$cmd{'got'}}) ) {
 436         $got =~ s/\r//g;
 437         chomp $got;
 438         print $diff_tool_tmp_fh "> $got\n" if ($diff_tool);
 439
 440         unless ( $enable_coverage and $got =~ /^profiling:/ ) {
 441             push @got, $got;
 442         }
 443     }
 444
 445     if ( $cmd{'sort'} ) {
 446
 447         # Save the unsorted observed output to report it on error.
 448         map { push @{ $cmd{'unsorted got'} }, $_ } @got;
 449
 450         sub mysort {
 451             substr( $a, 0, $sort_prefix ) cmp substr( $b, 0, $sort_prefix );
 452         }
 453         use sort 'stable';
 454         if ( $sort_prefix > 0 ) {
 455             @got = sort mysort @got;
 456         } else {
 457             @got = sort @got;
 458         }
 459         while ( @got and $got[0] eq "" ) {
 460             shift @got;
 461         }
 462
 463         # Sort the expected output to make it easier to write for humans
 464         if ( defined( $cmd{'out'} ) ) {
 465             if ( $sort_prefix > 0 ) {
 466                 @{ $cmd{'out'} } = sort mysort @{ $cmd{'out'} };
 467             } else {
 468                 @{ $cmd{'out'} } = sort @{ $cmd{'out'} };
 469             }
 470             while ( @{ $cmd{'out'} } and ${ $cmd{'out'} }[0] eq "" ) {
 471                 shift @{ $cmd{'out'} };
 472             }
 473         }
 474     }
 475
 476     # Did we timeout?
 477
 478     if ( $cmd{'timeouted'} ) {
 479         $gotret   = "timeout after $cmd{'timeout'} sec";
 480         $error    = 1;
 481         $exitcode = 3;
 482         print STDERR "<$cmd{'file'}:$cmd{'line'}> timeouted. Kill the process.\n";
 483     }
 484     if ( $gotret ne $wantret ) {
 485         $error = 1;
 486         my $msg = "Test suite `$cmd{'file'}': NOK (<$cmd{'file'}:$cmd{'line'}> $gotret)\n";
 487         if ( scalar @got ) {
 488             $msg = $msg . "Output of <$cmd{'file'}:$cmd{'line'}> so far:\n";
 489             map { $msg .= "|| $_\n" } @got;
 490         } else {
 491             $msg .= "<$cmd{'file'}:$cmd{'line'}> No output so far.\n";
 492         }
 493         print STDERR "$msg";
 494     }
 495
 496     # Does the output match?
 497     my $diff;
 498     if ( defined( $cmd{'output display'} ) ) {
 499         print "[Tesh/INFO] Here is the (ignored) command output:\n";
 500         map { print "||$_\n" } @got;
 501     } elsif ( defined( $cmd{'output ignore'} ) ) {
 502         print "(ignoring the output of <$cmd{'file'}:$cmd{'line'}> as requested)\n";
 503     } else {
 504         $diff = build_diff( \@{ $cmd{'out'} }, \@got );
 505     }
 506     if ( length $diff ) {
 507         print "Output of <$cmd{'file'}:$cmd{'line'}> mismatch" . ( $cmd{'sort'} ? " (even after sorting)" : "" ) . ":\n";
 508         map { print "$_\n" } split( /\n/, $diff );
 509         if ( $cmd{'sort'} ) {
 510             print "WARNING: Both the observed output and expected output were sorted as requested.\n";
 511             print "WARNING: Output were only sorted using the $sort_prefix first chars.\n"
 512               if ( $sort_prefix > 0 );
 513             print "WARNING: Use <! output sort 19> to sort by simulated date and process ID only.\n";
 514
 515             # print "----8<---------------  Begin of unprocessed observed output (as it should appear in file):\n";
 516             # map {print "> $_\n"} @{$cmd{'unsorted got'}};
 517             # print "--------------->8----  End of the unprocessed observed output.\n";
 518         }
 519
 520         print "Test suite `$cmd{'file'}': NOK (<$cmd{'file'}:$cmd{'line'}> output mismatch)\n";
 521         exit 2;
 522     }
 523 }
 524
 525 # parse tesh file
 526 my $infh;    # The file descriptor from which we should read the teshfile
 527 if ( $tesh_file eq "(stdin)" ) {
 528     $infh = *STDIN;
 529 } else {
 530     open $infh, $tesh_file
 531       or die "[Tesh/CRITICAL] Unable to open $tesh_file: $!\n";
 532 }
 533
 534 my %cmd;     # everything about the next command to run
 535 my $line_num = 0;
 536 LINE: while ( defined( my $line = <$infh> ) and not $error ) {
 537     chomp $line;
 538     $line =~ s/\r//g;
 539
 540     $line_num++;
 541     print "[TESH/debug] $line_num: $line\n" if $opts{'debug'};
 542
 543     # deal with line continuations
 544     while ( $line =~ /^(.*?)\\$/ ) {
 545         my $next = <$infh>;
 546         die "[TESH/CRITICAL] Continued line at end of file\n"
 547           unless defined($next);
 548         $line_num++;
 549         chomp $next;
 550         print "[TESH/debug] $line_num: $next\n" if $opts{'debug'};
 551         $line = $1 . $next;
 552     }
 553
 554     # Push delayed commands on empty lines
 555     unless ( $line =~ m/^(.)(.*)$/ ) {
 556         if ( defined( $cmd{'cmd'} ) ) {
 557             exec_cmd( \%cmd );
 558             %cmd = ();
 559         }
 560         print $diff_tool_tmp_fh "$line\n" if ($diff_tool);
 561         next LINE;
 562     }
 563
 564     my ( $cmd, $arg ) = ( $1, $2 );
 565     print $diff_tool_tmp_fh "$line\n" if ( $diff_tool and $cmd ne '>' );
 566     $arg =~ s/^ //g;
 567     $arg =~ s/\r//g;
 568     $arg =~ s/\\\\/\\/g;
 569
 570     # handle the commands
 571     if ( $cmd =~ /^#/ ) {    # comment
 572     } elsif ( $cmd eq '>' ) {    # expected result line
 573         print "[TESH/debug] push expected result\n" if $opts{'debug'};
 574         push @{ $cmd{'out'} }, $arg;
 575
 576     } elsif ( $cmd eq '<' ) {    # provided input
 577         print "[TESH/debug] push provided input\n" if $opts{'debug'};
 578         push @{ $cmd{'in'} }, $arg;
 579
 580     } elsif ( $cmd eq 'p' ) {    # comment
 581         print "[$tesh_name:$line_num] $arg\n";
 582
 583     } elsif ( $cmd eq '$' ) {    # Command
 584                                  # if we have something buffered, run it now
 585         if ( defined( $cmd{'cmd'} ) ) {
 586             exec_cmd( \%cmd );
 587             %cmd = ();
 588         }
 589         if ( $arg =~ /^\s*mkfile / ) {    # "mkfile" command line
 590             die "[TESH/CRITICAL] Output expected from mkfile command!\n"
 591               if scalar @{ cmd { 'out' } };
 592
 593             $cmd{'arg'} = $arg;
 594             $cmd{'arg'} =~ s/\s*mkfile //;
 595             mkfile_cmd( \%cmd );
 596             %cmd = ();
 597
 598         } elsif ( $arg =~ /^\s*cd / ) {
 599             die "[TESH/CRITICAL] Input provided to cd command!\n"
 600               if scalar @{ cmd { 'in' } };
 601             die "[TESH/CRITICAL] Output expected from cd command!\n"
 602               if scalar @{ cmd { 'out' } };
 603
 604             $arg =~ s/^ *cd //;
 605             cd_cmd($arg);
 606             %cmd = ();
 607
 608         } else {    # regular command
 609             $cmd{'cmd'}  = $arg;
 610             $cmd{'file'} = $tesh_file;
 611             $cmd{'line'} = $line_num;
 612         }
 613     } elsif ( $cmd eq '&' ) {    # background command line
 614
 615         if ( defined( $cmd{'cmd'} ) ) {
 616             exec_cmd( \%cmd );
 617             %cmd = ();
 618         }
 619         $cmd{'background'} = 1;
 620         $cmd{'cmd'}        = $arg;
 621         $cmd{'file'}       = $tesh_file;
 622         $cmd{'line'}       = $line_num;
 623
 624     } elsif ( $line =~ /^!\s*output sort/ ) {    #output sort
 625         if ( defined( $cmd{'cmd'} ) ) {
 626             exec_cmd( \%cmd );
 627             %cmd = ();
 628         }
 629         $cmd{'sort'} = 1;
 630         if ( $line =~ /^!\s*output sort\s+(\d+)/ ) {
 631             $sort_prefix = $1;
 632         }
 633     } elsif ( $line =~ /^!\s*output ignore/ ) {    #output ignore
 634         if ( defined( $cmd{'cmd'} ) ) {
 635             exec_cmd( \%cmd );
 636             %cmd = ();
 637         }
 638         $cmd{'output ignore'} = 1;
 639     } elsif ( $line =~ /^!\s*output display/ ) {    #output display
 640         if ( defined( $cmd{'cmd'} ) ) {
 641             exec_cmd( \%cmd );
 642             %cmd = ();
 643         }
 644         $cmd{'output display'} = 1;
 645     } elsif ( $line =~ /^!\s*expect signal (\w*)/ ) {    #expect signal SIGABRT
 646         if ( defined( $cmd{'cmd'} ) ) {
 647             exec_cmd( \%cmd );
 648             %cmd = ();
 649         }
 650         $cmd{'expect'} = "$1";
 651     } elsif ( $line =~ /^!\s*expect return/ ) {          #expect return
 652         if ( defined( $cmd{'cmd'} ) ) {
 653             exec_cmd( \%cmd );
 654             %cmd = ();
 655         }
 656         $line =~ s/^! expect return //g;
 657         $line =~ s/\r//g;
 658         $cmd{'return'} = $line;
 659     } elsif ( $line =~ /^!\s*setenv/ ) {                 #setenv
 660         if ( defined( $cmd{'cmd'} ) ) {
 661             exec_cmd( \%cmd );
 662             %cmd = ();
 663         }
 664         $line =~ s/^! setenv //g;
 665         $line =~ s/\r//g;
 666         setenv_cmd($line);
 667     } elsif ( $line =~ /^!\s*timeout/ ) {                #timeout
 668         if ( defined( $cmd{'cmd'} ) ) {
 669             exec_cmd( \%cmd );
 670             %cmd = ();
 671         }
 672         $line =~ s/^! timeout //;
 673         $line =~ s/\r//g;
 674         $cmd{'timeout'} = $line;
 675     } else {
 676         die "[TESH/CRITICAL] parse error: $line\n";
 677     }
 678 }
 679
 680 # We're done reading the input file
 681 close $infh unless ( $tesh_file eq "(stdin)" );
 682
 683 # Deal with last command
 684 if ( defined( $cmd{'cmd'} ) ) {
 685     exec_cmd( \%cmd );
 686     %cmd = ();
 687 }
 688
 689 foreach (@bg_cmds) {
 690     my %test = %{$_};
 691     analyze_result( \%test );
 692 }
 693
 694 if ($diff_tool) {
 695     close $diff_tool_tmp_fh;
 696     system("$diff_tool $diff_tool_tmp_filename $tesh_file");
 697     unlink $diff_tool_tmp_filename;
 698 }
 699
 700 if ( $error != 0 ) {
 701     exit $exitcode;
 702 } elsif ( $tesh_file eq "(stdin)" ) {
 703     print "Test suite from stdin OK\n";
 704 } else {
 705     print "Test suite `$tesh_name' OK\n";
 706 }
 707
 708 exit 0;
 709
 710 ####
 711 #### Helper functions
 712 ####
 713
 714 sub build_diff {
 715     my $res;
 716     my $diff = Diff->new(@_);
 717
 718     $diff->Base(1);    # Return line numbers, not indices
 719     my $chunk_count = $diff->Next(-1);    # Compute the amount of chuncks
 720     return "" if ( $chunk_count == 1 && $diff->Same() );
 721     $diff->Reset();
 722     while ( $diff->Next() ) {
 723         my @same = $diff->Same();
 724         if ( $diff->Same() ) {
 725             if ( $diff->Next(0) > 1 ) {    # not first chunk: print 2 first lines
 726                 $res .= '  ' . $same[0] . "\n";
 727                 $res .= '  ' . $same[1] . "\n" if ( scalar @same > 1 );
 728             }
 729             $res .= "...\n" if ( scalar @same > 2 );
 730
 731             #    $res .= $diff->Next(0)."/$chunk_count\n";
 732             if ( $diff->Next(0) < $chunk_count ) {    # not last chunk: print 2 last lines
 733                 $res .= '  ' . $same[ scalar @same - 2 ] . "\n"
 734                   if ( scalar @same > 1 );
 735                 $res .= '  ' . $same[ scalar @same - 1 ] . "\n";
 736             }
 737         }
 738         next if $diff->Same();
 739         map { $res .= "- $_\n" } $diff->Items(1);
 740         map { $res .= "+ $_\n" } $diff->Items(2);
 741     }
 742     return $res;
 743 }
 744
 745 # Helper function replacing any occurence of variable '$name' by its '$value'
 746 # As in Bash, ${$value:=BLABLA} is rewritten to $value if set or to BLABLA if $value is not set
 747 sub var_subst {
 748     my ( $text, $name, $value ) = @_;
 749     if ($value) {
 750         $text =~ s/\${$name(?::[=-][^}]*)?}/$value/g;
 751         $text =~ s/\$$name(\W|$)/$value$1/g;
 752     } else {
 753         $text =~ s/\${$name:=([^}]*)}/$1/g;
 754         $text =~ s/\${$name}//g;
 755         $text =~ s/\$$name(\W|$)/$1/g;
 756     }
 757     return $text;
 758 }
 759
 760 ################################  The possible commands  ################################
 761
 762 sub mkfile_cmd($) {
 763     my %cmd  = %{ $_[0] };
 764     my $file = $cmd{'arg'};
 765     print STDERR "[Tesh/INFO] mkfile $file. Ctn: >>".join( '\n', @{ $cmd{'in'} })."<<\n"
 766       if $opts{'debug'};
 767
 768     unlink($file);
 769     open( FILE, ">$file" )
 770       or die "[Tesh/CRITICAL] Unable to create file $file: $!\n";
 771     print FILE join( "\n", @{ $cmd{'in'} } );
 772     print FILE "\n" if ( scalar @{ $cmd{'in'} } > 0 );
 773     close(FILE);
 774 }
 775
 776 # Command CD. Just change to the provided directory
 777 sub cd_cmd($) {
 778     my $directory = shift;
 779     my $failure   = 1;
 780     if ( -e $directory && -d $directory ) {
 781         chdir("$directory");
 782         print "[Tesh/INFO] change directory to $directory\n";
 783         $failure = 0;
 784     } elsif ( -e $directory ) {
 785         print "Cannot change directory to '$directory': it is not a directory\n";
 786     } else {
 787         print "Chdir to $directory failed: No such file or directory\n";
 788     }
 789     if ( $failure == 1 ) {
 790         print "Test suite `$tesh_file': NOK (system error)\n";
 791         exit 4;
 792     }
 793 }
 794
 795 # Command setenv. Gets "variable=content", and update the environment accordingly
 796 sub setenv_cmd($) {
 797     my $arg = shift;
 798     if ( $arg =~ /^(.*)=(.*)$/ ) {
 799         my ( $var, $ctn ) = ( $1, $2 );
 800         print "[Tesh/INFO] setenv $var=$ctn\n";
 801         $environ{$var} = $ctn;
 802         $ENV{$var} = $ctn;
 803     } else {
 804         die "[Tesh/CRITICAL] Malformed argument to setenv: expected 'name=value' but got '$arg'\n";
 805     }
 806 }