Logo AND Algorithmique Numérique Distribuée

Public GIT Repository
[tesh] run perltidy
[simgrid.git] / 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