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