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