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<tesh_file>
  23
  24 =cut
  25
  26 BEGIN {
  27     # Disabling IPC::Run::Debug saves tons of useless calls.
  28     $ENV{'IPCRUNDEBUG'} = 'none'
  29       unless exists $ENV{'IPCRUNDEBUG'};
  30 }
  31
  32 my ($timeout)              = 0;
  33 my ($time_to_wait)         = 0;
  34 my $path                   = $0;
  35 my $enable_coverage        = 0;
  36 my $diff_tool              = 0;
  37 my $diff_tool_tmp_fh       = 0;
  38 my $diff_tool_tmp_filename = 0;
  39 my $sort_prefix            = -1;
  40 my $tesh_file;
  41 my $tesh_name;
  42 my $error    = 0;
  43 my $exitcode = 0;
  44 my @bg_cmds;
  45 my (%environ);
  46 $SIG{'PIPE'} = 'IGNORE';
  47 $path =~ s|[^/]*$||;
  48 push @INC, $path;
  49
  50 use lib "@CMAKE_BINARY_DIR@/bin";
  51
  52 use Diff qw(diff);    # postpone a bit to have time to change INC
  53
  54 use Getopt::Long qw(GetOptions);
  55 use strict;
  56 use Text::ParseWords;
  57 use IPC::Run qw(start run timeout finish);
  58 use IO::File;
  59 use English;
  60
  61 ####
  62 #### Portability bits for windows
  63 ####
  64
  65 use constant RUNNING_ON_WINDOWS => ( $OSNAME =~ /^(?:mswin|dos|os2)/oi );
  66 use POSIX qw(:sys_wait_h WIFEXITED WIFSIGNALED WIFSTOPPED WEXITSTATUS WTERMSIG WSTOPSIG
  67   :signal_h SIGINT SIGTERM SIGKILL SIGABRT SIGSEGV);
  68
  69 BEGIN {
  70     if (RUNNING_ON_WINDOWS) { # Missing on windows
  71         *WIFEXITED   = sub { not $_[0] & 127 };
  72         *WEXITSTATUS = sub { $_[0] >> 8 };
  73         *WIFSIGNALED = sub { ( $_[0] & 127 ) && ( $_[0] & 127 != 127 ) };
  74         *WTERMSIG    = sub { $_[0] & 127 };
  75     }
  76 }
  77
  78
  79 ####
  80 #### Command line option handling
  81 ####
  82
  83 if ( $ARGV[0] eq "--internal-killer-process" ) {
  84
  85     # We fork+exec a waiter process in charge of killing the command after timeout
  86     # If the command stops earlier, that's fine: the killer sends a signal to an already stopped process, fails, and quits.
  87     #    Nobody cares about the killer issues.
  88     #    The only problem could arise if another process is given the same PID than cmd. We bet it won't happen :)
  89     my $time_to_wait = $ARGV[1];
  90     my $pid          = $ARGV[2];
  91     sleep $time_to_wait;
  92     kill( 'TERM', $pid );
  93     sleep 1;
  94     kill( 'KILL', $pid );
  95     exit $time_to_wait;
  96 }
  97
  98 my %opts = ( "debug" => 0,
  99              "timeout" => 120, # No command should run any longer than 2 minutes by default
 100            );
 101
 102 Getopt::Long::config( 'bundling', 'no_getopt_compat', 'no_auto_abbrev' );
 103 GetOptions(
 104     'debug|d' => \$opts{"debug"},
 105
 106     'difftool=s' => \$diff_tool,
 107
 108     'cd=s'      => sub { cd_cmd( $_[1] ) },
 109     'timeout=s' => \$opts{'timeout'},
 110     'setenv=s'  => sub { setenv_cmd( $_[1] ) },
 111     'cfg=s' => sub { $opts{'cfg'} .= " --cfg=$_[1]" },
 112     'enable-coverage+' => \$enable_coverage,
 113 );
 114
 115 $tesh_file = pop @ARGV;
 116
 117 if ($enable_coverage) {
 118     print "Enable coverage\n";
 119 }
 120
 121 if ($diff_tool) {
 122     use File::Temp qw/ tempfile /;
 123     ( $diff_tool_tmp_fh, $diff_tool_tmp_filename ) = tempfile();
 124     print "New tesh: $diff_tool_tmp_filename\n";
 125 }
 126
 127 if ( $tesh_file =~ m/(.*)\.tesh/ ) {
 128     $tesh_name = $1;
 129     print "Test suite `$tesh_name'\n";
 130 } else {
 131     $tesh_file = "(stdin)";
 132     $tesh_name = "(stdin)";
 133     print "Test suite from stdin\n";
 134 }
 135
 136 ##
 137 ## File parsing
 138 ##
 139 my ($return) = -1;
 140 my ($forked);
 141 my ($config)      = "";
 142 my (@buffer_tesh) = ();
 143
 144 ###########################################################################
 145
 146 sub exit_status {
 147     my $status = shift;
 148     if ( WIFEXITED($status) ) {
 149         $exitcode = WEXITSTATUS($status) + 40;
 150         return "returned code " . WEXITSTATUS($status);
 151     } elsif ( WIFSIGNALED($status) ) {
 152         my $code;
 153         if    ( WTERMSIG($status) == SIGINT )  { $code = "SIGINT"; }
 154         elsif ( WTERMSIG($status) == SIGTERM ) { $code = "SIGTERM"; }
 155         elsif ( WTERMSIG($status) == SIGKILL ) { $code = "SIGKILL"; }
 156         elsif ( WTERMSIG($status) == SIGABRT ) { $code = "SIGABRT"; }
 157         elsif ( WTERMSIG($status) == SIGSEGV ) { $code = "SIGSEGV"; }
 158         $exitcode = WTERMSIG($status) + 4;
 159         return "got signal $code";
 160     }
 161     return "Unparsable status. Is the process stopped?";
 162 }
 163
 164 sub exec_cmd {
 165     my %cmd = %{ $_[0] };
 166     if ( $opts{'debug'} ) {
 167         map { print "IN: $_\n" } @{ $cmd{'in'} };
 168         map { print "OUT: $_\n" } @{ $cmd{'out'} };
 169         print "CMD: $cmd{'cmd'}\n";
 170     }
 171
 172     # cleanup the command line
 173     if (RUNNING_ON_WINDOWS) {
 174         var_subst( $cmd{'cmd'}, "EXEEXT", ".exe" );
 175     } else {
 176         var_subst( $cmd{'cmd'}, "EXEEXT", "" );
 177     }
 178
 179     # substitute environ variables
 180     foreach my $key ( keys %environ ) {
 181         $cmd{'cmd'} = var_subst( $cmd{'cmd'}, $key, $environ{$key} );
 182     }
 183
 184     # substitute remaining variables, if any
 185     while ( $cmd{'cmd'} =~ /\${(\w+)(?::[=-][^}]*)?}/ ) {
 186         $cmd{'cmd'} = var_subst( $cmd{'cmd'}, $1, "" );
 187     }
 188     while ( $cmd{'cmd'} =~ /\$(\w+)/ ) {
 189         $cmd{'cmd'} = var_subst( $cmd{'cmd'}, $1, "" );
 190     }
 191
 192     # add cfg options
 193     $cmd{'cmd'} .= " $opts{'cfg'}"
 194       if ( defined( $opts{'cfg'} ) && length( $opts{'cfg'} ) );
 195
 196     # finally trim any remaining space chars
 197     $cmd{'cmd'} =~ s/^\s+//;
 198     $cmd{'cmd'} =~ s/\s+$//;
 199
 200     print "[$tesh_name:$cmd{'line'}] $cmd{'cmd'}\n";
 201
 202     $cmd{'return'} ||= 0;
 203     $cmd{'timeout'} ||= $opts{'timeout'};
 204
 205
 206     ###
 207     # exec the command line
 208
 209     my @cmdline = quotewords( '\s+', 0, $cmd{'cmd'} );
 210     my $input = defined($cmd{'in'})? join("\n",@{$cmd{'in'}}) : "";
 211     my $output = " " x 10240; $output = ""; # Preallocate 10kB, and reset length to 0
 212     $cmd{'got'} = \$output;
 213     $cmd{'job'} = start \@cmdline, '<', \$input, '>&', \$output, timeout($cmd{'timeout'});
 214
 215     if ( $cmd{'background'} ) {
 216         # Just enqueue the job. It will be dealed with at the end
 217         push @bg_cmds, \%cmd;
 218     } else {
 219         # Deal with its ending conditions right away
 220         analyze_result( \%cmd );
 221     }
 222 }
 223
 224 sub analyze_result {
 225     my %cmd    = %{ $_[0] };
 226
 227     eval {
 228         finish( $cmd{'job'} );
 229     };
 230     if ($@) {
 231         if ($@ =~ /timeout/) {
 232             $cmd{'job'}->kill_kill;
 233             $cmd{'timeouted'} = 1;
 234         } elsif ($@ =~ /^ack / and $@ =~ /pipe/) {
 235             print STDERR "Tesh: Broken pipe (ignored).\n";
 236         } else {
 237             die $@; # Don't know what it is, so let it go.
 238         }
 239     }
 240     $cmd{'timeouted'} ||= 0;
 241
 242     my $gotret = $cmd{'gotret'} = exit_status($?);
 243
 244     my $wantret;
 245
 246     if ( defined( $cmd{'expect'} ) and ( $cmd{'expect'} ne "" ) ) {
 247         $wantret = "got signal $cmd{'expect'}";
 248     } else {
 249         $wantret = "returned code " . ( defined( $cmd{'return'} ) ? $cmd{'return'} : 0 );
 250     }
 251
 252     # pop all output from executing child
 253     my @got;
 254     map { print "GOT: $_\n" } ${$cmd{'got'}} if $opts{'debug'};
 255     foreach my $got ( split("\n", ${$cmd{'got'}}) ) {
 256         $got =~ s/\r//g;
 257         chomp $got;
 258         print $diff_tool_tmp_fh "> $got\n" if ($diff_tool);
 259
 260         unless ( $enable_coverage and $got =~ /^profiling:/ ) {
 261             push @got, $got;
 262         }
 263     }
 264
 265     if ( $cmd{'sort'} ) {
 266
 267         # Save the unsorted observed output to report it on error.
 268         map { push @{ $cmd{'unsorted got'} }, $_ } @got;
 269
 270         sub mysort {
 271             substr( $a, 0, $sort_prefix ) cmp substr( $b, 0, $sort_prefix );
 272         }
 273         use sort 'stable';
 274         if ( $sort_prefix > 0 ) {
 275             @got = sort mysort @got;
 276         } else {
 277             @got = sort @got;
 278         }
 279         while ( @got and $got[0] eq "" ) {
 280             shift @got;
 281         }
 282
 283         # Sort the expected output to make it easier to write for humans
 284         if ( defined( $cmd{'out'} ) ) {
 285             if ( $sort_prefix > 0 ) {
 286                 @{ $cmd{'out'} } = sort mysort @{ $cmd{'out'} };
 287             } else {
 288                 @{ $cmd{'out'} } = sort @{ $cmd{'out'} };
 289             }
 290             while ( @{ $cmd{'out'} } and ${ $cmd{'out'} }[0] eq "" ) {
 291                 shift @{ $cmd{'out'} };
 292             }
 293         }
 294     }
 295
 296     # Did we timeout ? If yes, handle it. If not, kill the forked process.
 297
 298     if ( $cmd{'timeouted'} ) {
 299         $gotret   = "timeout after $cmd{'timeout'} sec";
 300         $error    = 1;
 301         $exitcode = 3;
 302         print STDERR "<$cmd{'file'}:$cmd{'line'}> timeouted. Kill the process.\n";
 303     }
 304     if ( $gotret ne $wantret ) {
 305         $error = 1;
 306         my $msg = "Test suite `$cmd{'file'}': NOK (<$cmd{'file'}:$cmd{'line'}> $gotret)\n";
 307         if ( scalar @got ) {
 308             $msg = $msg . "Output of <$cmd{'file'}:$cmd{'line'}> so far:\n";
 309             map { $msg .= "|| $_\n" } @got;
 310         } else {
 311             $msg .= "<$cmd{'file'}:$cmd{'line'}> No output so far.\n";
 312         }
 313         print STDERR "$msg";
 314     }
 315
 316     ###
 317     # Check the result of execution
 318     ###
 319     my $diff;
 320     if ( defined( $cmd{'output display'} ) ) {
 321         print "[Tesh/INFO] Here is the (ignored) command output:\n";
 322         map { print "||$_\n" } @got;
 323     } elsif ( defined( $cmd{'output ignore'} ) ) {
 324         print "(ignoring the output of <$cmd{'file'}:$cmd{'line'}> as requested)\n";
 325     } else {
 326         $diff = build_diff( \@{ $cmd{'out'} }, \@got );
 327     }
 328     if ( length $diff ) {
 329         print "Output of <$cmd{'file'}:$cmd{'line'}> mismatch" . ( $cmd{'sort'} ? " (even after sorting)" : "" ) . ":\n";
 330         map { print "$_\n" } split( /\n/, $diff );
 331         if ( $cmd{'sort'} ) {
 332             print "WARNING: Both the observed output and expected output were sorted as requested.\n";
 333             print "WARNING: Output were only sorted using the $sort_prefix first chars.\n"
 334               if ( $sort_prefix > 0 );
 335             print "WARNING: Use <! output sort 19> to sort by simulated date and process ID only.\n";
 336
 337             # print "----8<---------------  Begin of unprocessed observed output (as it should appear in file):\n";
 338             # map {print "> $_\n"} @{$cmd{'unsorted got'}};
 339             # print "--------------->8----  End of the unprocessed observed output.\n";
 340         }
 341
 342         print "Test suite `$cmd{'file'}': NOK (<$cmd{'file'}:$cmd{'line'}> output mismatch)\n";
 343         exit 2;
 344     }
 345 }
 346
 347 # parse tesh file
 348 my $infh;    # The file descriptor from which we should read the teshfile
 349 if ( $tesh_file eq "(stdin)" ) {
 350     $infh = *STDIN;
 351 } else {
 352     open $infh, $tesh_file
 353       or die "[Tesh/CRITICAL] Unable to open $tesh_file: $!\n";
 354 }
 355
 356 my %cmd;     # everything about the next command to run
 357 my $line_num = 0;
 358 LINE: while ( defined( my $line = <$infh> ) and not $error ) {
 359     chomp $line;
 360     $line =~ s/\r//g;
 361
 362     $line_num++;
 363     print "[TESH/debug] $line_num: $line\n" if $opts{'debug'};
 364     my $next;
 365
 366     # deal with line continuations
 367     while ( $line =~ /^(.*?)\\$/ ) {
 368         $next = <$infh>;
 369         die "[TESH/CRITICAL] Continued line at end of file\n"
 370           unless defined($next);
 371         $line_num++;
 372         chomp $next;
 373         print "[TESH/debug] $line_num: $next\n" if $opts{'debug'};
 374         $line = $1 . $next;
 375     }
 376
 377     # Push delayed commands on empty lines
 378     unless ( $line =~ m/^(.)(.*)$/ ) {
 379         if ( defined( $cmd{'cmd'} ) ) {
 380             exec_cmd( \%cmd );
 381             %cmd = ();
 382         }
 383         print $diff_tool_tmp_fh "$line\n" if ($diff_tool);
 384         next LINE;
 385     }
 386
 387     my ( $cmd, $arg ) = ( $1, $2 );
 388     print $diff_tool_tmp_fh "$line\n" if ( $diff_tool and $cmd ne '>' );
 389     $arg =~ s/^ //g;
 390     $arg =~ s/\r//g;
 391     $arg =~ s/\\\\/\\/g;
 392
 393     # handle the commands
 394     if ( $cmd =~ /^#/ ) {    # comment
 395     } elsif ( $cmd eq '>' ) {    # expected result line
 396         print "[TESH/debug] push expected result\n" if $opts{'debug'};
 397         push @{ $cmd{'out'} }, $arg;
 398
 399     } elsif ( $cmd eq '<' ) {    # provided input
 400         print "[TESH/debug] push provided input\n" if $opts{'debug'};
 401         push @{ $cmd{'in'} }, $arg;
 402
 403     } elsif ( $cmd eq 'p' ) {    # comment
 404         print "[$tesh_name:$line_num] $arg\n";
 405
 406     } elsif ( $cmd eq '$' ) {    # Command
 407                                  # if we have something buffered, run it now
 408         if ( defined( $cmd{'cmd'} ) ) {
 409             exec_cmd( \%cmd );
 410             %cmd = ();
 411         }
 412         if ( $arg =~ /^\s*mkfile / ) {    # "mkfile" command line
 413             die "[TESH/CRITICAL] Output expected from mkfile command!\n"
 414               if scalar @{ cmd { 'out' } };
 415
 416             $cmd{'arg'} = $arg;
 417             $cmd{'arg'} =~ s/\s*mkfile //;
 418             mkfile_cmd( \%cmd );
 419             %cmd = ();
 420
 421         } elsif ( $arg =~ /^\s*cd / ) {
 422             die "[TESH/CRITICAL] Input provided to cd command!\n"
 423               if scalar @{ cmd { 'in' } };
 424             die "[TESH/CRITICAL] Output expected from cd command!\n"
 425               if scalar @{ cmd { 'out' } };
 426
 427             $arg =~ s/^ *cd //;
 428             cd_cmd($arg);
 429             %cmd = ();
 430
 431         } else {    # regular command
 432             $cmd{'cmd'}  = $arg;
 433             $cmd{'file'} = $tesh_file;
 434             $cmd{'line'} = $line_num;
 435         }
 436     } elsif ( $cmd eq '&' ) {    # background command line
 437
 438         if ( defined( $cmd{'cmd'} ) ) {
 439             exec_cmd( \%cmd );
 440             %cmd = ();
 441         }
 442         $cmd{'background'} = 1;
 443         $cmd{'cmd'}        = $arg;
 444         $cmd{'file'}       = $tesh_file;
 445         $cmd{'line'}       = $line_num;
 446
 447     } elsif ( $line =~ /^!\s*output sort/ ) {    #output sort
 448         if ( defined( $cmd{'cmd'} ) ) {
 449             exec_cmd( \%cmd );
 450             %cmd = ();
 451         }
 452         $cmd{'sort'} = 1;
 453         if ( $line =~ /^!\s*output sort\s+(\d+)/ ) {
 454             $sort_prefix = $1;
 455         }
 456     } elsif ( $line =~ /^!\s*output ignore/ ) {    #output ignore
 457         if ( defined( $cmd{'cmd'} ) ) {
 458             exec_cmd( \%cmd );
 459             %cmd = ();
 460         }
 461         $cmd{'output ignore'} = 1;
 462     } elsif ( $line =~ /^!\s*output display/ ) {    #output display
 463         if ( defined( $cmd{'cmd'} ) ) {
 464             exec_cmd( \%cmd );
 465             %cmd = ();
 466         }
 467         $cmd{'output display'} = 1;
 468     } elsif ( $line =~ /^!\s*expect signal (\w*)/ ) {    #expect signal SIGABRT
 469         if ( defined( $cmd{'cmd'} ) ) {
 470             exec_cmd( \%cmd );
 471             %cmd = ();
 472         }
 473         $cmd{'expect'} = "$1";
 474     } elsif ( $line =~ /^!\s*expect return/ ) {          #expect return
 475         if ( defined( $cmd{'cmd'} ) ) {
 476             exec_cmd( \%cmd );
 477             %cmd = ();
 478         }
 479         $line =~ s/^! expect return //g;
 480         $line =~ s/\r//g;
 481         $cmd{'return'} = $line;
 482     } elsif ( $line =~ /^!\s*setenv/ ) {                 #setenv
 483         if ( defined( $cmd{'cmd'} ) ) {
 484             exec_cmd( \%cmd );
 485             %cmd = ();
 486         }
 487         $line =~ s/^! setenv //g;
 488         $line =~ s/\r//g;
 489         setenv_cmd($line);
 490     } elsif ( $line =~ /^!\s*timeout/ ) {                #timeout
 491         if ( defined( $cmd{'cmd'} ) ) {
 492             exec_cmd( \%cmd );
 493             %cmd = ();
 494         }
 495         $line =~ s/^! timeout //;
 496         $line =~ s/\r//g;
 497         $cmd{'timeout'} = $line;
 498     } else {
 499         die "[TESH/CRITICAL] parse error: $line\n";
 500     }
 501     if ($forked) {
 502         kill( 'KILL', $forked );
 503         $timeout = 0;
 504     }
 505 }
 506
 507 # We're done reading the input file
 508 close $infh unless ( $tesh_file eq "(stdin)" );
 509
 510 # Deal with last command
 511 if ( defined( $cmd{'cmd'} ) ) {
 512     exec_cmd( \%cmd );
 513     %cmd = ();
 514 }
 515
 516 if ($forked) {
 517     kill( 'KILL', $forked );
 518     $timeout = 0;
 519 }
 520
 521 foreach (@bg_cmds) {
 522     my %test = %{$_};
 523     analyze_result( \%test );
 524 }
 525
 526 if ($diff_tool) {
 527     close $diff_tool_tmp_fh;
 528     system("$diff_tool $diff_tool_tmp_filename $tesh_file");
 529     unlink $diff_tool_tmp_filename;
 530 }
 531
 532 if ( $error != 0 ) {
 533     exit $exitcode;
 534 } elsif ( $tesh_file eq "(stdin)" ) {
 535     print "Test suite from stdin OK\n";
 536 } else {
 537     print "Test suite `$tesh_name' OK\n";
 538 }
 539
 540 ####
 541 #### Helper functions
 542 ####
 543
 544 sub build_diff {
 545     my $res;
 546     my $diff = Diff->new(@_);
 547
 548     $diff->Base(1);    # Return line numbers, not indices
 549     my $chunk_count = $diff->Next(-1);    # Compute the amount of chuncks
 550     return "" if ( $chunk_count == 1 && $diff->Same() );
 551     $diff->Reset();
 552     while ( $diff->Next() ) {
 553         my @same = $diff->Same();
 554         if ( $diff->Same() ) {
 555             if ( $diff->Next(0) > 1 ) {    # not first chunk: print 2 first lines
 556                 $res .= '  ' . $same[0] . "\n";
 557                 $res .= '  ' . $same[1] . "\n" if ( scalar @same > 1 );
 558             }
 559             $res .= "...\n" if ( scalar @same > 2 );
 560
 561             #    $res .= $diff->Next(0)."/$chunk_count\n";
 562             if ( $diff->Next(0) < $chunk_count ) {    # not last chunk: print 2 last lines
 563                 $res .= '  ' . $same[ scalar @same - 2 ] . "\n"
 564                   if ( scalar @same > 1 );
 565                 $res .= '  ' . $same[ scalar @same - 1 ] . "\n";
 566             }
 567         }
 568         next if $diff->Same();
 569         map { $res .= "- $_\n" } $diff->Items(1);
 570         map { $res .= "+ $_\n" } $diff->Items(2);
 571     }
 572     return $res;
 573 }
 574
 575 # Helper function replacing any occurence of variable '$name' by its '$value'
 576 # As in Bash, ${$value:=BLABLA} is rewritten to $value if set or to BLABLA if $value is not set
 577 sub var_subst {
 578     my ( $text, $name, $value ) = @_;
 579     if ($value) {
 580         $text =~ s/\${$name(?::[=-][^}]*)?}/$value/g;
 581         $text =~ s/\$$name(\W|$)/$value$1/g;
 582     } else {
 583         $text =~ s/\${$name:=([^}]*)}/$1/g;
 584         $text =~ s/\${$name}//g;
 585         $text =~ s/\$$name(\W|$)/$1/g;
 586     }
 587     return $text;
 588 }
 589
 590 ################################  The possible commands  ################################
 591
 592 sub mkfile_cmd($) {
 593     my %cmd  = %{ $_[0] };
 594     my $file = $cmd{'arg'};
 595     print STDERR "[Tesh/INFO] mkfile $file. Ctn: >>".join( '\n', @{ $cmd{'in'} })."<<\n"
 596       if $opts{'debug'};
 597
 598     unlink($file);
 599     open( FILE, ">$file" )
 600       or die "[Tesh/CRITICAL] Unable to create file $file: $!\n";
 601     print FILE join( "\n", @{ $cmd{'in'} } );
 602     print FILE "\n" if ( scalar @{ $cmd{'in'} } > 0 );
 603     close(FILE);
 604 }
 605
 606 # Command CD. Just change to the provided directory
 607 sub cd_cmd($) {
 608     my $directory = shift;
 609     my $failure   = 1;
 610     if ( -e $directory && -d $directory ) {
 611         chdir("$directory");
 612         print "[Tesh/INFO] change directory to $directory\n";
 613         $failure = 0;
 614     } elsif ( -e $directory ) {
 615         print "Cannot change directory to '$directory': it is not a directory\n";
 616     } else {
 617         print "Chdir to $directory failed: No such file or directory\n";
 618     }
 619     if ( $failure == 1 ) {
 620         print "Test suite `$tesh_file': NOK (system error)\n";
 621         exit 4;
 622     }
 623 }
 624
 625 # Command setenv. Gets "variable=content", and update the environment accordingly
 626 sub setenv_cmd($) {
 627     my $arg = shift;
 628     if ( $arg =~ /^(.*)=(.*)$/ ) {
 629         my ( $var, $ctn ) = ( $1, $2 );
 630         print "[Tesh/INFO] setenv $var=$ctn\n";
 631         $environ{$var} = $ctn;
 632         $ENV{$var} = $ctn;
 633     } else {
 634         die "[Tesh/CRITICAL] Malformed argument to setenv: expected 'name=value' but got '$arg'\n";
 635     }
 636 }