X-Git-Url: http://info.iut-bm.univ-fcomte.fr/pub/gitweb/simgrid.git/blobdiff_plain/363ae066badd453c806244ee48a0f18da4643261..2a283885f92b85ae047ff92372b5fb1df1f9ef9c:/buildtools/Cmake/tesh.pl diff --git a/buildtools/Cmake/tesh.pl b/buildtools/Cmake/tesh.pl index 87e6adc2e0..28296d6a32 100755 --- a/buildtools/Cmake/tesh.pl +++ b/buildtools/Cmake/tesh.pl @@ -1,296 +1,436 @@ -#! /usr/bin/perl -w +#! /usr/bin/perl +eval 'exec perl -S $0 ${1+"$@"}' + if $running_under_some_shell; +=encoding UTF-8 + +=head1 NAME + +tesh -- testing shell + +=head1 SYNOPSIS + +B [I] I + +=cut +my($bindir); +my($srcdir); +my $path = $0; +$path =~ s|[^/]*$||; +push @INC,$path; + +use Getopt::Long qw(GetOptions); use strict; +use Term::ANSIColor; +use IPC::Open3; -if($#ARGV<0){die "Usage: tesh.pl \n";} -my($line1); -my($line2); -my($execline); -my($ok)=0; -my($ok1)=0; -my($sort)=0; -my($nb_arg)=0; -my($result); -my(@list1)=(); -my(@list2)=(); -my(@list3)=(); -my(@buffer)=(); -my($timeout)=-1; -my($parallel)=0; -my($verbose)=0; -my($encore)=0; -my($old_buffer); +my($OS)=`echo %OS%`; +if($OS eq "%OS%"){ + $OS = "UNIX"; +} +else{ + $OS = "WIN"; +} -#options -do{ - if($ARGV[$nb_arg] =~ /^--cd$/) - { - $nb_arg++; - if(!$ARGV[$nb_arg] or $ARGV[$nb_arg] =~ /^--/){die "Usage: tesh.pl --cd \n";} - my($directory)=$ARGV[$nb_arg]; - if( -e $directory) - { - chdir("$directory"); - print "[Tesh/INFO] Change directory to \"$directory\"\n"; - } - else - { - die "[Tesh/CRITICAL] Directory not found : \"$directory\"\n"; - } - $nb_arg++; - } - elsif($ARGV[$nb_arg] =~ /^--setenv$/) - { - $nb_arg++; - if(!$ARGV[$nb_arg] or $ARGV[$nb_arg] =~ /^--/){die "Usage: tesh.pl --setenv environment_variable\n";} - if(!$ARGV[$nb_arg+1] or $ARGV[$nb_arg+1] =~ /^--/){die "Usage: tesh.pl --setenv environment_variable\n";} - $ENV{$ARGV[$nb_arg]} = "$ENV{$ARGV[$nb_arg]}:$ARGV[$nb_arg+1]"; - print "[Tesh/INFO] export $ARGV[$nb_arg]=\"$ENV{$ARGV[$nb_arg]}\"\n"; - $nb_arg++; - $nb_arg++; - } - elsif($ARGV[$nb_arg] =~ /^--verbose$/) - { - $verbose=1; - } - else - { - print "[Tesh/CRITICAL] Unrecognized option : $ARGV[$nb_arg]\n"; - $nb_arg++; - } -}while(($nb_arg) < $#ARGV); +# make sure we received a tesh file +scalar @ARGV > 0 || die "Usage:\n tesh [*options*] *tesh_file*\n"; #Add current directory to path $ENV{PATH} = "$ENV{PATH}:."; -#tesh file -if(!$ARGV[$nb_arg]){die "tesh.pl \n";} -print "[Tesh/INFO] load file : $ARGV[$nb_arg]\n"; -my($file)=$ARGV[$nb_arg]; -open SH_LIGNE, $file or die "[Tesh/CRITICAL] Unable to open $file. $!\n"; - -while(defined($line1=)) -{ - if($line1 =~ /^\$ /){ #command line - $line1 =~ s/\$\{srcdir\:\=\.\}/./g; - $line1 =~ s/\${EXEEXT:=}//g; - $line1 =~ s/^\$\ *//g; - $line1 =~ s/^.\/lua/lua/g; - $line1 =~ s/^.\/ruby/ruby/g; - $line1 =~ s/^.\///g; - $line1 =~ s/\(%i:%P@%h\)/\\\(%i:%P@%h\\\)/g; - chomp $line1; - if(@list1){ - print "[Tesh/CRITICAL] Old result : @list1"; - print "[Tesh/CRITICAL] Previous result not check!"; - die;} - if($parallel == 1) - { - $execline = "$execline \& $line1 2>&1"; - print "[Tesh/INFO] exec_line // : $execline\n"; - } - else - { - $ok = 1; - $execline = "$line1 2>&1"; - print "[Tesh/INFO] exec_line : $execline\n"; - $result=`$execline`; - @list1 = split(/\n/,$result); - } + +## +## Command line option handling +## + +# option handling helper subs +sub cd_cmd { + my $directory=$_[1]; + if (-e $directory && -d $directory) { + chdir("$directory"); + print "[Tesh/INFO] change directory to $directory\n"; + } elsif (-e $directory) { + die "[Tesh/CRITICAL] Cannot change directory to '$directory': it is not a directory\n"; + } else { + die "[Tesh/CRITICAL] Cannot change directory to '$directory': no such directory\n"; + } +} + +sub setenv_cmd { + if ($_[1] =~ /^(.*)=(.*)$/) { + my($var,$ctn)=($1,$2); + + if($var =~ /bindir/){ + print "[Tesh/INFO] setenv $var=$ctn\n"; + $bindir = $ctn; } - elsif($line1 =~ /^\& /){ # parallel command line - $line1 =~ s/\$\{srcdir\:\=\.\}/./g; - $line1 =~ s/\${EXEEXT:=}//g; - $line1 =~ s/^\& //g; - $line1 =~ s/^.\/lua/lua/g; - $line1 =~ s/^.\/ruby/ruby/g; - $line1 =~ s/^.\///g; - $line1 =~ s/\(%i:%P@%h\)/\\\(%i:%P@%h\\\)/g; - chomp $line1; - if(@list1){ - print "Old result : @list1"; - die "Previous result not check!";} - if($parallel == 1) - { - $execline = "$execline \& $line1 2>&1"; - print "[Tesh/INFO] exec_line // : $execline\n"; + else + { + if($var =~ /srcdir/){ + $srcdir = $ctn; } - else - { - $parallel = 1; - $execline = "$line1 2>&1"; - print "[Tesh/INFO] exec_line // : $execline\n"; + else{ + $ENV{$var} = $ctn; + print "[Tesh/INFO] setenv $var=$ctn\n"; } - } - elsif($line1 =~ /^\>/){ #expected result line - if($ok == 0 and $parallel== 0){die "No command line\n";} - $ok1 = 1; - $line1 =~ s/^\> //g; - $line1 =~ s/\r//g; - chomp $line1; - push @list2, $line1; - } - elsif($line1 =~ /^\ 0, + "debug" => 0, + "verbose" => 0 + ); + + Getopt::Long::config('bundling', 'no_getopt_compat', 'no_auto_abbrev'); + + GetOptions( + 'help|h' => \$opt{'help'}, + + 'verbose|v' => \@verbose, + 'debug|d' => \$opt{"debug"}, + + 'cd=s' => \&cd_cmd, + 'setenv=s' => \&setenv_cmd, + 'cfg=s' => \@cfg, + 'log=s' => \$log, + ); + + $opt{'verbose'} = scalar @verbose; + foreach (@cfg) { + $opt{'cfg'} .= " --cfg=$_"; + } + return %opt; +} + +my %opts = get_options(@ARGV); + +## +## File parsing +## +my($sort)=0; +my($nb_arg)=0; +my($timeout)=0; +my($old_buffer); +my($linebis); +my($SIGABRT)=0; +my($no_output_ignore)=1; +my($verbose)=0; +my($return)=-1; +my($pid); +my($result); +my($result_err); +my($forked); +my($config)=""; + +my($tesh_command)=0; +my(@buffer_tesh)=(); + +eval { + use POSIX; + sub exit_status { + my $status = shift; + if (POSIX::WIFEXITED($status)) { + return "returned code ".POSIX::WEXITSTATUS($status); + } elsif (POSIX::WIFSIGNALED($status)) { + return "got signal ".$SIG{POSIX::WTERMSIG($status)}; } - elsif($line1 =~ /^! output sort/){ #output sort - print "[Tesh/INFO] output sort\n"; - $sort=1; + return "Unparsable status. Is the process stopped?"; + } +}; +if ($@) { # no POSIX available? + warn "POSIX not usable to parse the return value of forked child: $@\n"; + sub exit_status { + return "returned code 0"; + } +} + +sub exec_cmd { + my %cmd = %{$_[0]}; + if ($opts{'debug'}) { + print "IN BEGIN\n"; + map {print " $_"} @{$cmd{'in'}}; + print "IN END\n"; + print "OUT BEGIN\n"; + map {print " $_"} @{$cmd{'out'}}; + print "OUT END\n"; + print "CMD: $cmd{'cmd'}\n"; + } + + # cleanup the command line + if($OS eq "WIN"){ + $cmd{'cmd'} =~ s/\${EXEEXT:=}/.exe/g; } - elsif($line1 =~ /^! expect return/){ #expect sort - print "[Tesh/CRITICAL] expect return\n"; - die; + else{ + $cmd{'cmd'} =~ s/\${EXEEXT:=}//g; } - elsif($line1 =~ /^! setenv/){ #setenv - $line1 =~ s/^! setenv //g; - $line1 =~ s/\r//g; - chomp $line1; - $line1 =~ /^(.*)=(.*)$/; - $ENV{$1} = $2; - print "[Tesh/INFO] setenv: $1=$2\n"; + $cmd{'cmd'} =~ s/\${bindir:=}/$bindir/g; + $cmd{'cmd'} =~ s/\${srcdir:=}/$srcdir/g; + $cmd{'cmd'} =~ s/\${bindir:=.}/$bindir/g; + $cmd{'cmd'} =~ s/\${srcdir:=.}/$srcdir/g; + $cmd{'cmd'} =~ s/\${bindir}/$bindir/g; + $cmd{'cmd'} =~ s/\${srcdir}/$srcdir/g; + $cmd{'cmd'} =~ s|^\./||g; +# $cmd{'cmd'} =~ s|tesh|tesh.pl|g; + $cmd{'cmd'} =~ s/\(%i:%P@%h\)/\\\(%i:%P@%h\\\)/g; + $cmd{'cmd'} .= " $opts{'cfg'}" if (defined($opts{'cfg'}) && length($opts{'cfg'})); + + print "[$cmd{'file'}:$cmd{'line'}] $cmd{'cmd'}\n"; + + ### + # exec the command line + ### + $pid = open3(\*IN, \*OUT, \*OUT, $cmd{'cmd'} ); + + # if timeout specified, fork and kill executing child at the end of timeout + if ($timeout){ + $forked = fork(); + die "fork() failed: $!" unless defined $forked; + if ( $forked == 0 ) { # child + sleep $timeout; + kill(9, $pid); + exit; } - elsif($line1 =~ /^! include/){ #output sort - die "[Tesh/CRITICAL] need include\n"; + } + + # push all provided input to executing child + map { print IN "$_\n" } $cmd{'in'}; + close IN; + + # pop all output from executing child + my @got; + while(defined(my $got=)) { + $got =~ s/\r//g; + #$got =~ s/^( )*//g; + chomp $got; + push @got, "$got"; + } + close OUT; + + # Cleanup the executing child, and kill the timeouter brother on need + $cmd{'return'} = 0 unless defined($cmd{'return'}); + my $wantret = "returned code ".(defined($cmd{'return'})? $cmd{'return'} : 0); + waitpid ($pid, 0); + my $gotret = exit_status($?); + if($gotret ne $wantret) { + my $msg = "Test suite `$cmd{'file'}': NOK (<$cmd{'file'}:$cmd{'line'}> $gotret)\n". + "Output of <$cmd{'file'}:$cmd{'line'}> so far:\n"; + map {$msg .= "|| $_\n"} @got; + print STDERR "$msg"; + exit(1); + } + if($timeout){kill(9, $forked);$timeout=0;} + $timeout = 0; + + ### + # Check the result of execution + ### + my $diff = build_diff(\@{$cmd{'out'}}, \@got); + if (length $diff) { + print color("red")."[TESH/CRITICAL$$] Output mismatch\n"; + map { print "[TESH/CRITICAL] $_\n" } split(/\n/,$diff); + print color("reset"); + die "Tesh failed\n"; + } +} + +sub mkfile_cmd { + my %cmd = %{$_[0]}; + my $file = $cmd{'arg'}; + print "[Tesh/INFO] mkfile $file\n"; + + die "[TESH/CRITICAL] no input provided to mkfile\n" unless defined($cmd{'in'}) && scalar @{$cmd{'in'}}; + unlink($file); + open(FILE,">$file") or die "[Tesh/CRITICAL] Unable to create file $file: $!\n"; + print FILE join("\n", @{$cmd{'in'}}); + print FILE "\n" if (scalar @{$cmd{'in'}} > 0); + close(FILE); +} + +# parse tesh file +print "Test suite $tesh_file\n"; +open TESH_FILE, $tesh_file or die "[Tesh/CRITICAL] Unable to open $tesh_file $!\n"; + + +my %cmd; # everything about the next command to run +my $line_num=0; +LINE: while (defined(my $line=)) { + $line_num++; + chomp $line; + print "[TESH/debug] $line_num: $line\n" if $opts{'debug'}; + + # deal with line continuations + while ($line =~ /^(.*?)\\$/) { + my $next=; + die "[TESH/CRITICAL] Continued line at end of file\n" + unless defined($next); + chomp $next; + print "[TESH/debug] $line_num: $next\n" if $opts{'debug'}; + $line = $1.$next; + } + + # Push delayed commands on empty lines + unless ($line =~ m/^(..)(.*)$/) { + if (defined($cmd{'cmd'})) { + exec_cmd(\%cmd); + %cmd = (); } - elsif($line1 =~ /^! timeout/){ #timeout - $line1 =~ s/^! timeout //g; - $line1 =~ s/\r//g; - chomp $line1; - $timeout = $line1; - print "[Tesh/INFO] timeout : $timeout\n"; + next LINE; + } + + my ($cmd,$arg) = ($1,$2); + $arg =~ s/\r//g; + + # handle the commands + if ($cmd =~ /^#/) { #comment + } elsif ($cmd eq '> '){ #expected result line + print "[TESH/debug] push expected result\n" if $opts{'debug'}; + push @{$cmd{'out'}}, $arg; + + } elsif ($cmd eq '< ') { # provided input + print "[TESH/debug] push provided input\n" if $opts{'debug'}; + push @{$cmd{'in'}}, $arg; + + } elsif ($cmd eq 'p ') { # comment + print "[Tesh/INFO] $arg\n"; + + } elsif ($cmd eq '$ ') { # Command + # if we have something buffered, run it now + if (defined($cmd{'cmd'})) { + exec_cmd(\%cmd); + %cmd = (); } - elsif($ok == 1 and $ok1 == 1) - { - @buffer = (); - if($sort == 1) - { - @list3 = sort @list1; - @list1=(); - @list1=@list3; - @list3=(); - - @list3 = sort @list2; - @list2=(); - @list2=@list3; - @list3=(); - - $sort=0; - } - while(@list1 or @list2) - { - $line1 = shift (@list1); - $line2 = shift (@list2); - if($line2 and $line1) - { - if($line1 eq $line2){ - if($verbose == 1){print "$line1\n";} - else{push @buffer, "$line1\n";} - - } - else - { if($verbose == 0){print @buffer}; - if($line2) {print "- $line2\n"}; - if($line1) {print "+ $line1\n"}; - die; - } - } - else - { if($verbose == 0){print @buffer}; - if($line2) {print "- $line2\n"}; - if($line1) {print "+ $line1\n"}; - die; - } - } - $ok = 0; - $ok1= 0; - @list1=(); - @list2=(); - @buffer = (); - $result = (); + if ($arg =~ /^ *mkfile /){ # "mkfile" command line + die "[TESH/CRITICAL] Output expected from mkfile command!\n" if scalar @{cmd{'out'}}; + + $cmd{'arg'} = $arg; + $cmd{'arg'} =~ s/ *mkfile //; + mkfile_cmd(\%cmd); + %cmd = (); + + } elsif ($arg =~ /^ *cd /) { + die "[TESH/CRITICAL] Input provided to cd command!\n" if scalar @{cmd{'in'}}; + die "[TESH/CRITICAL] Output expected from cd command!\n" if scalar @{cmd{'out'}}; + + $arg =~ s/^ *cd //; + cd_cmd("",$arg); + %cmd = (); + + } else { # regular command + $cmd{'cmd'} = $arg; + $cmd{'file'} = $tesh_file; + $cmd{'line'} = $line_num; } + } + elsif($cmd eq '& '){ # parallel command line + $cmd{'background'} = 1; + $cmd{'cmd'} = $arg; + } + elsif($line =~ /^! output sort/){ #output sort + $cmd{'sort'} = 1; + } + elsif($line =~ /^! output ignore/){ #output ignore + $cmd{'output ignore'} = 1; + } + elsif($line =~ /^! expect signal SIGABRT$/) {#expect signal SIGABRT + $cmd{'expect'} = "SIGABRT"; + } + elsif($line =~ /^! expect return/){ #expect return + $line =~ s/^! expect return //g; + $line =~ s/\r//g; + $cmd{'return'} = $line; + } + elsif($line =~ /^! setenv/){ #setenv + $line =~ s/^! setenv //g; + $line =~ s/\r//g; + setenv_cmd($line); + } + elsif($line =~ /^! include/){ #output sort + print color("red"), "[Tesh/CRITICAL] need include"; + print color("reset"), "\n"; + die; + } + elsif($line =~ /^! timeout/){ #timeout + $line =~ s/^! timeout //; + $line =~ s/\r//g; + $cmd{'timeout'} = $line; + } else { + die "[TESH/CRITICAL] parse error: $line\n"; + } } -if($parallel == 1) -{ - $ok = 1; - $result=`$execline`; - @list1 = split(/\n/,$result); +# Deal with last command +if (defined($cmd{'cmd'})) { + exec_cmd(\%cmd); + %cmd = (); } -elsif($ok == 1 and $ok1 == 1) - { - @buffer = (); - if($sort == 1) - { - @list3 = sort @list1; - @list1=(); - @list1=@list3; - @list3=(); - - @list3 = sort @list2; - @list2=(); - @list2=@list3; - @list3=(); - - $sort=0; - } - while(@list1 or @list2) - { - $line1 = shift (@list1); - $line2 = shift (@list2); - if($line2 and $line1) - { - if($line1 eq $line2){ - if($verbose == 1){print "$line1\n";} - else{push @buffer, "$line1\n";} - - } - else - { if($verbose == 0){print @buffer}; - if($line2) {print "- $line2\n"}; - if($line1) {print "+ $line1\n"}; - die; - } - } - else - { if($verbose == 0){print @buffer}; - if($line2) {print "- $line2\n"}; - if($line1) {print "+ $line1\n"}; - die; - } - } - $ok = 0; - $ok1= 0; - @list1=(); - @list2=(); - @buffer = (); -} \ No newline at end of file + +#my (@a,@b); +#push @a,"bl1"; push @b,"bl1"; +#push @a,"bl2"; push @b,"bl2"; +#push @a,"bl3"; push @b,"bl3"; +#push @a,"bl4"; push @b,"bl4"; +#push @a,"bl5"; push @b,"bl5"; +#push @a,"bl6"; push @b,"bl6"; +#push @a,"bl7"; push @b,"bl7"; +##push @a,"Perl"; push @b,"ruby"; +#push @a,"END1"; push @b,"END1"; +#push @a,"END2"; push @b,"END2"; +#push @a,"END3"; push @b,"END3"; +#push @a,"END4"; push @b,"END4"; +#push @a,"END5"; push @b,"END5"; +#push @a,"END6"; push @b,"END6"; +#push @a,"END7"; push @b,"END7"; +#print "Identical:\n". build_diff(\@a,\@b); + +#@a = (); @b =(); +#push @a,"AZE"; push @b,"EZA"; +#print "Different:\n".build_diff(\@a,\@b); + +use Diff qw(diff); # postpone a bit to have time to change INC + +sub build_diff { + my $res; + my $diff = Diff->new(@_); + + $diff->Base( 1 ); # Return line numbers, not indices + my $chunk_count = $diff->Next(-1); # Compute the amount of chuncks + return "" if ($chunk_count == 1 && $diff->Same()); + $diff->Reset(); + while( $diff->Next() ) { + my @same = $diff->Same(); + if ($diff->Same() ) { + if ($diff->Next(0) > 1) { # not first chunk: print 2 first lines + $res .= ' '.$same[0]."\n" ; + $res .= ' '.$same[1]."\n" if (scalar @same>1); + } + $res .= "...\n" if (scalar @same>2); +# $res .= $diff->Next(0)."/$chunk_count\n"; + if ($diff->Next(0) < $chunk_count) { # not last chunk: print 2 last lines + $res .= ' '.$same[scalar @same -2]."\n" if (scalar @same>1); + $res .= ' '.$same[scalar @same -1]."\n"; + } + } + next if $diff->Same(); + map { $res .= "- $_\n" } $diff->Items(1); + map { $res .= "+ $_\n" } $diff->Items(2); + } + return $res; +} + +