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