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