Logo AND Algorithmique Numérique Distribuée

Public GIT Repository
[tesh] kill dead code
[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 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 = $_[1];
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 ( $var, $ctn );
122     if ( $_[0] =~ /^(.*)=(.*)$/ ) {
123         ( $var, $ctn ) = ( $1, $2 );
124     } elsif ( $_[1] =~ /^(.*)=(.*)$/ ) {
125         ( $var, $ctn ) = ( $1, $2 );
126     } else {
127         die "[Tesh/CRITICAL] Malformed argument to setenv: expected 'name=value' but got '$_[1]'\n";
128     }
129
130     print "[Tesh/INFO] setenv $var=$ctn\n";
131     $environ{$var} = $ctn;
132 }
133
134 # Main option parsing sub
135
136 sub get_options {
137
138     # remove the tesh file from the ARGV used
139     my @ARGV = @_;
140     $tesh_file = pop @ARGV;
141
142     # temporary arrays for GetOption
143     my @cfg;
144     my $log;    # ignored
145
146     my %opt = (
147         "help"  => 0,
148         "debug" => 0,
149     );
150
151     Getopt::Long::config( 'bundling', 'no_getopt_compat', 'no_auto_abbrev' );
152
153     GetOptions(
154         'help|h' => \$opt{'help'},
155
156         'debug|d' => \$opt{"debug"},
157
158         'difftool=s' => \$diff_tool,
159
160         'cd=s'             => \&cd_cmd,
161         'timeout=s'        => \$opt{'timeout'},
162         'setenv=s'         => \&setenv_cmd,
163         'cfg=s'            => \@cfg,
164         'log=s'            => \$log,
165         'enable-coverage+' => \$enable_coverage,
166     );
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(@ARGV);
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     ###  $line =~ s/\r//g;
268
269     $cmd{'got'} = IO::File->new_tmpfile;
270     $cmd{'got'}->autoflush(1);
271     local *E = $cmd{'got'};
272     $cmd{'pid'} =
273       open3( \*CHILD_IN, ">&E", ">&E", quotewords( '\s+', 0, $cmd{'cmd'} ) );
274
275     # push all provided input to executing child
276     map { print CHILD_IN "$_\n"; } @{ $cmd{'in'} };
277     close CHILD_IN;
278
279     # if timeout specified, fork and kill executing child at the end of timeout
280     if ( not $cmd{'background'}
281         and ( defined( $cmd{'timeout'} ) or defined( $opts{'timeout'} ) ) )
282     {
283         $time_to_wait =
284           defined( $cmd{'timeout'} ) ? $cmd{'timeout'} : $opts{'timeout'};
285         $forked  = fork();
286         $timeout = -1;
287         die "fork() failed: $!" unless defined $forked;
288         if ( $forked == 0 ) {    # child
289             exec("$PROGRAM_NAME --internal-killer-process $time_to_wait $cmd{'pid'}");
290         }
291     }
292
293     # Cleanup the executing child, and kill the timeouter brother on need
294     $cmd{'return'} = 0 unless defined( $cmd{'return'} );
295     if ( $cmd{'background'} != 1 ) {
296         waitpid( $cmd{'pid'}, 0 );
297         $cmd{'gotret'} = exit_status($?);
298         parse_out( \%cmd );
299     } else {
300
301         # & commands, which will be handled at the end
302         push @bg_cmds, \%cmd;
303     }
304 }
305
306 sub parse_out {
307     my %cmd    = %{ $_[0] };
308     my $gotret = $cmd{'gotret'};
309
310     my $wantret;
311
312     if ( defined( $cmd{'expect'} ) and ( $cmd{'expect'} ne "" ) ) {
313         $wantret = "got signal $cmd{'expect'}";
314     } else {
315         $wantret =
316           "returned code " . ( defined( $cmd{'return'} ) ? $cmd{'return'} : 0 );
317     }
318
319     local *got = $cmd{'got'};
320     seek( got, 0, 0 );
321
322     # pop all output from executing child
323     my @got;
324     while ( defined( my $got = <got> ) ) {
325         $got =~ s/\r//g;
326         chomp $got;
327         print $diff_tool_tmp_fh "> $got\n" if ($diff_tool);
328
329         if ( !( $enable_coverage and $got =~ /^profiling:/ ) ) {
330             push @got, $got;
331         }
332     }
333
334     if ( $cmd{'sort'} ) {
335
336         # Save the unsorted observed output to report it on error.
337         map { push @{ $cmd{'unsorted got'} }, $_ } @got;
338
339         sub mysort {
340             substr( $a, 0, $sort_prefix ) cmp substr( $b, 0, $sort_prefix );
341         }
342         use sort 'stable';
343         if ( $sort_prefix > 0 ) {
344             @got = sort mysort @got;
345         } else {
346             @got = sort @got;
347         }
348         while ( @got and $got[0] eq "" ) {
349             shift @got;
350         }
351
352         # Sort the expected output to make it easier to write for humans
353         if ( defined( $cmd{'out'} ) ) {
354             if ( $sort_prefix > 0 ) {
355                 @{ $cmd{'out'} } = sort mysort @{ $cmd{'out'} };
356             } else {
357                 @{ $cmd{'out'} } = sort @{ $cmd{'out'} };
358             }
359             while ( @{ $cmd{'out'} } and ${ $cmd{'out'} }[0] eq "" ) {
360                 shift @{ $cmd{'out'} };
361             }
362         }
363     }
364
365     # Did we timeout ? If yes, handle it. If not, kill the forked process.
366
367     if ( $timeout == -1
368         and ( $gotret eq "got signal SIGTERM" or $gotret eq "got signal SIGKILL" ) )
369     {
370         $gotret   = "return code 0";
371         $timeout  = 1;
372         $gotret   = "timeout after $time_to_wait sec";
373         $error    = 1;
374         $exitcode = 3;
375         print STDERR "<$cmd{'file'}:$cmd{'line'}> timeouted. Kill the process.\n";
376     } else {
377         $timeout = 0;
378     }
379     if ( $gotret ne $wantret ) {
380         $error = 1;
381         my $msg = "Test suite `$cmd{'file'}': NOK (<$cmd{'file'}:$cmd{'line'}> $gotret)\n";
382         if ( $timeout != 1 ) {
383             $msg = $msg . "Output of <$cmd{'file'}:$cmd{'line'}> so far:\n";
384         }
385         map { $msg .= "|| $_\n" } @got;
386         if ( !@got ) {
387             if ( $timeout == 1 ) {
388                 print STDERR "<$cmd{'file'}:$cmd{'line'}> No output before timeout\n";
389             } else {
390                 $msg .= "||\n";
391             }
392         }
393         $timeout = 0;
394         print STDERR "$msg";
395     }
396
397     ###
398     # Check the result of execution
399     ###
400     my $diff;
401     if ( defined( $cmd{'output display'} ) ) {
402         print "[Tesh/INFO] Here is the (ignored) command output:\n";
403         map { print "||$_\n" } @got;
404     } elsif ( defined( $cmd{'output ignore'} ) ) {
405         print "(ignoring the output of <$cmd{'file'}:$cmd{'line'}> as requested)\n";
406     } else {
407         $diff = build_diff( \@{ $cmd{'out'} }, \@got );
408     }
409     if ( length $diff ) {
410         print "Output of <$cmd{'file'}:$cmd{'line'}> mismatch" . ( $cmd{'sort'} ? " (even after sorting)" : "" ) . ":\n";
411         map { print "$_\n" } split( /\n/, $diff );
412         if ( $cmd{'sort'} ) {
413             print "WARNING: Both the observed output and expected output were sorted as requested.\n";
414             print "WARNING: Output were only sorted using the $sort_prefix first chars.\n"
415               if ( $sort_prefix > 0 );
416             print "WARNING: Use <! output sort 19> to sort by simulated date and process ID only.\n";
417
418             # print "----8<---------------  Begin of unprocessed observed output (as it should appear in file):\n";
419             # map {print "> $_\n"} @{$cmd{'unsorted got'}};
420             # print "--------------->8----  End of the unprocessed observed output.\n";
421         }
422
423         print "Test suite `$cmd{'file'}': NOK (<$cmd{'file'}:$cmd{'line'}> output mismatch)\n";
424         exit 2;
425     }
426 }
427
428 sub mkfile_cmd {
429     my %cmd  = %{ $_[0] };
430     my $file = $cmd{'arg'};
431     print "[Tesh/INFO] mkfile $file\n";
432
433     unlink($file);
434     open( FILE, ">$file" )
435       or die "[Tesh/CRITICAL] Unable to create file $file: $!\n";
436     print FILE join( "\n", @{ $cmd{'in'} } );
437     print FILE "\n" if ( scalar @{ $cmd{'in'} } > 0 );
438     close(FILE);
439 }
440
441 # parse tesh file
442 my $infh;    # The file descriptor from which we should read the teshfile
443 if ( $tesh_file eq "(stdin)" ) {
444     $infh = *STDIN;
445 } else {
446     open $infh, $tesh_file
447       or die "[Tesh/CRITICAL] Unable to open $tesh_file: $!\n";
448 }
449
450 my %cmd;     # everything about the next command to run
451 my $line_num = 0;
452 LINE: while ( defined( my $line = <$infh> ) and not $error ) {
453     chomp $line;
454     $line =~ s/\r//g;
455
456     $line_num++;
457     print "[TESH/debug] $line_num: $line\n" if $opts{'debug'};
458     my $next;
459
460     # deal with line continuations
461     while ( $line =~ /^(.*?)\\$/ ) {
462         $next = <$infh>;
463         die "[TESH/CRITICAL] Continued line at end of file\n"
464           unless defined($next);
465         $line_num++;
466         chomp $next;
467         print "[TESH/debug] $line_num: $next\n" if $opts{'debug'};
468         $line = $1 . $next;
469     }
470
471     # Push delayed commands on empty lines
472     unless ( $line =~ m/^(.)(.*)$/ ) {
473         if ( defined( $cmd{'cmd'} ) ) {
474             exec_cmd( \%cmd );
475             %cmd = ();
476         }
477         print $diff_tool_tmp_fh "$line\n" if ($diff_tool);
478         next LINE;
479     }
480
481     my ( $cmd, $arg ) = ( $1, $2 );
482     print $diff_tool_tmp_fh "$line\n" if ( $diff_tool and $cmd ne '>' );
483     $arg =~ s/^ //g;
484     $arg =~ s/\r//g;
485     $arg =~ s/\\\\/\\/g;
486
487     # handle the commands
488     if ( $cmd =~ /^#/ ) {    # comment
489     } elsif ( $cmd eq '>' ) {    # expected result line
490         print "[TESH/debug] push expected result\n" if $opts{'debug'};
491         push @{ $cmd{'out'} }, $arg;
492
493     } elsif ( $cmd eq '<' ) {    # provided input
494         print "[TESH/debug] push provided input\n" if $opts{'debug'};
495         push @{ $cmd{'in'} }, $arg;
496
497     } elsif ( $cmd eq 'p' ) {    # comment
498         print "[$tesh_name:$line_num] $arg\n";
499
500     } elsif ( $cmd eq '$' ) {    # Command
501                                  # if we have something buffered, run it now
502         if ( defined( $cmd{'cmd'} ) ) {
503             exec_cmd( \%cmd );
504             %cmd = ();
505         }
506         if ( $arg =~ /^\s*mkfile / ) {    # "mkfile" command line
507             die "[TESH/CRITICAL] Output expected from mkfile command!\n"
508               if scalar @{ cmd { 'out' } };
509
510             $cmd{'arg'} = $arg;
511             $cmd{'arg'} =~ s/\s*mkfile //;
512             mkfile_cmd( \%cmd );
513             %cmd = ();
514
515         } elsif ( $arg =~ /^\s*cd / ) {
516             die "[TESH/CRITICAL] Input provided to cd command!\n"
517               if scalar @{ cmd { 'in' } };
518             die "[TESH/CRITICAL] Output expected from cd command!\n"
519               if scalar @{ cmd { 'out' } };
520
521             $arg =~ s/^ *cd //;
522             cd_cmd( "", $arg );
523             %cmd = ();
524
525         } else {    # regular command
526             $cmd{'cmd'}  = $arg;
527             $cmd{'file'} = $tesh_file;
528             $cmd{'line'} = $line_num;
529         }
530     } elsif ( $cmd eq '&' ) {    # background command line
531
532         if ( defined( $cmd{'cmd'} ) ) {
533             exec_cmd( \%cmd );
534             %cmd = ();
535         }
536         $cmd{'background'} = 1;
537         $cmd{'cmd'}        = $arg;
538         $cmd{'file'}       = $tesh_file;
539         $cmd{'line'}       = $line_num;
540         
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*timeout/ ) {                #timeout
586         if ( defined( $cmd{'cmd'} ) ) {
587             exec_cmd( \%cmd );
588             %cmd = ();
589         }
590         $line =~ s/^! timeout //;
591         $line =~ s/\r//g;
592         $cmd{'timeout'} = $line;
593     } else {
594         die "[TESH/CRITICAL] parse error: $line\n";
595     }
596     if ($forked) {
597         kill( 'KILL', $forked );
598         $timeout = 0;
599     }
600 }
601
602 # We're done reading the input file
603 close $infh unless ( $tesh_file eq "(stdin)" );
604
605 # Deal with last command
606 if ( defined( $cmd{'cmd'} ) ) {
607     exec_cmd( \%cmd );
608     %cmd = ();
609 }
610
611 if ($forked) {
612     kill( 'KILL', $forked );
613     $timeout = 0;
614 }
615
616 foreach (@bg_cmds) {
617     my %test = %{$_};
618     waitpid( $test{'pid'}, 0 );
619     $test{'gotret'} = exit_status($?);
620     parse_out( \%test );
621 }
622
623 @bg_cmds = ();
624
625 if ($diff_tool) {
626     close $diff_tool_tmp_fh;
627     system("$diff_tool $diff_tool_tmp_filename $tesh_file");
628     unlink $diff_tool_tmp_filename;
629 }
630
631 if ( $error != 0 ) {
632     exit $exitcode;
633 } elsif ( $tesh_file eq "(stdin)" ) {
634     print "Test suite from stdin OK\n";
635 } else {
636     print "Test suite `$tesh_name' OK\n";
637 }
638
639 #my (@a,@b);
640 #push @a,"bl1";   push @b,"bl1";
641 #push @a,"bl2";   push @b,"bl2";
642 #push @a,"bl3";   push @b,"bl3";
643 #push @a,"bl4";   push @b,"bl4";
644 #push @a,"bl5";   push @b,"bl5";
645 #push @a,"bl6";   push @b,"bl6";
646 #push @a,"bl7";   push @b,"bl7";
647 ##push @a,"Perl";  push @b,"ruby";
648 #push @a,"END1";   push @b,"END1";
649 #push @a,"END2";   push @b,"END2";
650 #push @a,"END3";   push @b,"END3";
651 #push @a,"END4";   push @b,"END4";
652 #push @a,"END5";   push @b,"END5";
653 #push @a,"END6";   push @b,"END6";
654 #push @a,"END7";   push @b,"END7";
655 #print "Identical:\n". build_diff(\@a,\@b);
656
657 #@a = (); @b =();
658 #push @a,"AZE"; push @b,"EZA";
659 #print "Different:\n".build_diff(\@a,\@b);
660
661 use lib "@CMAKE_BINARY_DIR@/bin";
662
663 use Diff qw(diff);    # postpone a bit to have time to change INC
664
665 sub build_diff {
666     my $res;
667     my $diff = Diff->new(@_);
668
669     $diff->Base(1);    # Return line numbers, not indices
670     my $chunk_count = $diff->Next(-1);    # Compute the amount of chuncks
671     return "" if ( $chunk_count == 1 && $diff->Same() );
672     $diff->Reset();
673     while ( $diff->Next() ) {
674         my @same = $diff->Same();
675         if ( $diff->Same() ) {
676             if ( $diff->Next(0) > 1 ) {    # not first chunk: print 2 first lines
677                 $res .= '  ' . $same[0] . "\n";
678                 $res .= '  ' . $same[1] . "\n" if ( scalar @same > 1 );
679             }
680             $res .= "...\n" if ( scalar @same > 2 );
681
682             #    $res .= $diff->Next(0)."/$chunk_count\n";
683             if ( $diff->Next(0) < $chunk_count ) {    # not last chunk: print 2 last lines
684                 $res .= '  ' . $same[ scalar @same - 2 ] . "\n"
685                   if ( scalar @same > 1 );
686                 $res .= '  ' . $same[ scalar @same - 1 ] . "\n";
687             }
688         }
689         next if $diff->Same();
690         map { $res .= "- $_\n" } $diff->Items(1);
691         map { $res .= "+ $_\n" } $diff->Items(2);
692     }
693     return $res;
694 }
695