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