Logo AND Algorithmique Numérique Distribuée

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