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