X-Git-Url: http://info.iut-bm.univ-fcomte.fr/pub/gitweb/simgrid.git/blobdiff_plain/0e4c1ba4f9c048eeded4100ca48716a4378a4870..ee841c4d0c10c563c3c34a24b615e9052d98fbb2:/buildtools/Cmake/Scripts/tesh.pl diff --git a/buildtools/Cmake/Scripts/tesh.pl b/buildtools/Cmake/Scripts/tesh.pl index f9f54d6608..9f218e9101 100755 --- a/buildtools/Cmake/Scripts/tesh.pl +++ b/buildtools/Cmake/Scripts/tesh.pl @@ -1,4 +1,10 @@ #! /usr/bin/perl + +# Copyright (c) 2012-2014. The SimGrid Team. +# All rights reserved. + +# This program is free software; you can redistribute it and/or modify it +# under the terms of the license (GNU LGPL) which comes with this package. eval 'exec perl -S $0 ${1+"$@"}' if $running_under_some_shell; @@ -20,18 +26,24 @@ my($time_to_wait)=0; my $path = $0; my $OS; my $enable_coverage=0; +my $diff_tool=0; +my $diff_tool_tmp_fh=0; +my $diff_tool_tmp_filename=0; +my $sort_prefix = 19; my $tesh_file; my $tesh_name; my $error=0; my $exitcode=0; my @bg_cmds; - +my (%environ); +$SIG{'PIPE'} = 'IGNORE'; $path =~ s|[^/]*$||; push @INC,$path; use Getopt::Long qw(GetOptions); use strict; use Term::ANSIColor; +use Text::ParseWords; use IPC::Open3; use IO::File; @@ -40,16 +52,27 @@ if($^O eq "linux"){ } else{ $OS = "WIN"; - $ENV{"PRINTF_EXPONENT_DIGITS"} = "2"; + $ENV{"PRINTF_EXPONENT_DIGITS"} = "2"; } -#Add current directory to path -$ENV{PATH} = "$ENV{PATH}:."; - ## ## Command line option handling ## +sub var_subst { + my ($text, $name, $value) = @_; + if ($value) { + $text =~ s/\${$name(?::[=-][^}]*)?}/$value/g; + $text =~ s/\$$name(\W|$)/$value$1/g; + } + else { + $text =~ s/\${$name:=([^}]*)}/$1/g; + $text =~ s/\${$name}//g; + $text =~ s/\$$name(\W|$)/$1/g; + } + return $text; +} + # option handling helper subs sub cd_cmd { my $directory=$_[1]; @@ -77,24 +100,12 @@ sub setenv_cmd { ($var,$ctn)=($1,$2); }elsif ($_[1] =~ /^(.*)=(.*)$/) { ($var,$ctn)=($1,$2); - } else { + } else { die "[Tesh/CRITICAL] Malformed argument to setenv: expected 'name=value' but got '$_[1]'\n"; } - - if($var =~ /bindir/){ - print "[Tesh/INFO] setenv $var=$ctn\n"; - $bindir = $ctn; - } - else - { - if($var =~ /srcdir/){ - $srcdir = $ctn; - } - else{ - $ENV{$var} = $ctn; - print "[Tesh/INFO] setenv $var=$ctn\n"; - } - } + + print "[Tesh/INFO] setenv $var=$ctn\n"; + $environ{$var} = $ctn; } # Main option parsing sub @@ -117,25 +128,33 @@ sub get_options { ); Getopt::Long::config('bundling', 'no_getopt_compat', 'no_auto_abbrev'); - + GetOptions( 'help|h' => \$opt{'help'}, 'verbose|v' => \@verbose, 'debug|d' => \$opt{"debug"}, + 'difftool=s' => \$diff_tool, + 'cd=s' => \&cd_cmd, - 'timeout=s' => \$opt{'timeout'}, + 'timeout=s' => \$opt{'timeout'}, 'setenv=s' => \&setenv_cmd, 'cfg=s' => \@cfg, 'log=s' => \$log, - 'enable-coverage+' => \$enable_coverage, + 'enable-coverage+' => \$enable_coverage, ); if($enable_coverage){ print "Enable coverage\n"; } + if($diff_tool){ + use File::Temp qw/ tempfile /; + ($diff_tool_tmp_fh, $diff_tool_tmp_filename) = tempfile(); + print "New tesh: $diff_tool_tmp_filename\n"; + } + unless($tesh_file=~/(.*)\.tesh/){ $tesh_file="(stdin)"; $tesh_name="(stdin)"; @@ -199,7 +218,7 @@ my(@buffer_tesh)=(); # } #} -sub exec_cmd { +sub exec_cmd { my %cmd = %{$_[0]}; if ($opts{'debug'}) { print "IN BEGIN\n"; @@ -212,25 +231,31 @@ sub exec_cmd { } # cleanup the command line - if($OS eq "WIN"){ - $cmd{'cmd'} =~ s/\${EXEEXT:=}/.exe/g; - $cmd{'cmd'} =~ s/\${EXEEXT}/.exe/g; - $cmd{'cmd'} =~ s/\$EXEEXT/.exe/g; - } - else{ - $cmd{'cmd'} =~ s/\${EXEEXT:=}//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/\${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; + if($OS eq "WIN") { + var_subst($cmd{'cmd'}, "EXEEXT", ".exe"); + } else { + var_subst($cmd{'cmd'}, "EXEEXT", ""); + } + + # substitute environ variables + foreach my $key (keys %environ) { + $cmd{'cmd'} = var_subst($cmd{'cmd'}, $key, $environ{$key}); + } + # substitute remaining variables, if any + while ($cmd{'cmd'} =~ /\${(\w+)(?::[=-][^}]*)?}/) { + $cmd{'cmd'} = var_subst($cmd{'cmd'}, $1, ""); + } + while ($cmd{'cmd'} =~ /\$(\w+)/) { + $cmd{'cmd'} = var_subst($cmd{'cmd'}, $1, ""); + } + + # add cfg options $cmd{'cmd'} .= " $opts{'cfg'}" if (defined($opts{'cfg'}) && length($opts{'cfg'})); + # final cleanup + $cmd{'cmd'} =~ s/^\s+//; + $cmd{'cmd'} =~ s/\s+$//; + print "[$tesh_name:$cmd{'line'}] $cmd{'cmd'}\n" ; ### @@ -239,8 +264,9 @@ sub exec_cmd { $cmd{'got'} = IO::File->new_tmpfile; $cmd{'got'}->autoflush(1); - local *E = $cmd{'got'}; - $cmd{'pid'} = open3(\*CHILD_IN, ">&E", ">&E", $cmd{'cmd'} ); + local *E = $cmd{'got'}; + $cmd{'pid'} = open3(\*CHILD_IN, ">&E", ">&E", + quotewords('\s+', 0, $cmd{'cmd'})); # push all provided input to executing child map { print CHILD_IN "$_\n"; } @{$cmd{'in'}}; @@ -259,7 +285,7 @@ sub exec_cmd { } } - + # Cleanup the executing child, and kill the timeouter brother on need $cmd{'return'} = 0 unless defined($cmd{'return'}); if($cmd{'background'} != 1){ @@ -279,7 +305,7 @@ sub exec_cmd { } -sub parse_out { +sub parse_out { my %cmd = %{$_[0]}; my $gotret=$cmd{'gotret'}; @@ -298,20 +324,29 @@ sub parse_out { while(defined(my $got=)) { $got =~ s/\r//g; chomp $got; + print $diff_tool_tmp_fh "> $got\n" if ($diff_tool); + if (!($enable_coverage and $got=~ /^profiling:/)){ push @got, $got; } - } + } - if ($cmd{'sort'}){ + if ($cmd{'sort'}){ sub mysort{ - $a cmp $b + substr($a, 0, $sort_prefix) cmp substr($b, 0, $sort_prefix) } - use sort qw(defaults _quicksort); # force quicksort + use sort 'stable'; @got = sort mysort @got; + while (@got and $got[0] eq "") { + shift @got; + } + #also resort the other one, as perl sort is not the same as the C one used to generate teshes if(defined($cmd{'out'})){ @{$cmd{'out'}}=sort mysort @{$cmd{'out'}}; + while (@{$cmd{'out'}} and ${$cmd{'out'}}[0] eq "") { + shift @{$cmd{'out'}}; + } } } @@ -325,13 +360,13 @@ sub parse_out { $exitcode=3; print STDERR "<$cmd{'file'}:$cmd{'line'}> timeouted. Kill the process.\n"; }else{ - $timeout=0; + $timeout=0; } if($gotret ne $wantret) { $error=1; my $msg = "Test suite `$cmd{'file'}': NOK (<$cmd{'file'}:$cmd{'line'}> $gotret)\n"; if ($timeout!=1) { - $msg=$msg."Output of <$cmd{'file'}:$cmd{'line'}> so far:\n"; + $msg=$msg."Output of <$cmd{'file'}:$cmd{'line'}> so far:\n"; } map {$msg .= "|| $_\n"} @got; if(!@got) { @@ -345,15 +380,19 @@ sub parse_out { print STDERR "$msg"; } - + ### - # Check the result of execution + # Check the result of execution ### my $diff; - if (!defined($cmd{'output ignore'})){ + if (defined($cmd{'output display'})){ + print "[Tesh/INFO] Here is the (ignored) command output:\n"; + map { print "||$_\n" } @got; + } + elsif (!defined($cmd{'output ignore'})){ $diff = build_diff(\@{$cmd{'out'}}, \@got); }else{ - print "(ignoring the output of <$cmd{'file'}:$cmd{'line'}> as requested)\n" + print "(ignoring the output of <$cmd{'file'}:$cmd{'line'}> as requested)\n" } if (length $diff) { print "Output of <$cmd{'file'}:$cmd{'line'}> mismatch:\n"; @@ -400,7 +439,6 @@ LINE: while (not $finished and not $error) { next LINE; } - $line_num++; chomp $line; $line =~ s/\r//g; @@ -423,10 +461,12 @@ LINE: while (not $finished and not $error) { exec_cmd(\%cmd); %cmd = (); } + print $diff_tool_tmp_fh "$line\n" if ($diff_tool); next LINE; - } - + } + my ($cmd,$arg) = ($1,$2); + print $diff_tool_tmp_fh "$line\n" if ($diff_tool and $cmd ne '>'); $arg =~ s/^ //g; $arg =~ s/\r//g; $arg =~ s/\\\\/\\/g; @@ -481,13 +521,16 @@ LINE: while (not $finished and not $error) { $cmd{'cmd'} = $arg; $cmd{'file'} = $tesh_file; $cmd{'line'} = $line_num; - } + } elsif($line =~ /^!\s*output sort/){ #output sort if (defined($cmd{'cmd'})) { exec_cmd(\%cmd); %cmd = (); } $cmd{'sort'} = 1; + if ($line =~ /^!\s*output sort\s+(\d+)/) { + $sort_prefix = $1; + } } elsif($line =~ /^!\s*output ignore/){ #output ignore if (defined($cmd{'cmd'})) { @@ -496,6 +539,13 @@ LINE: while (not $finished and not $error) { } $cmd{'output ignore'} = 1; } + elsif($line =~ /^!\s*output display/){ #output display + if (defined($cmd{'cmd'})) { + exec_cmd(\%cmd); + %cmd = (); + } + $cmd{'output display'} = 1; + } elsif($line =~ /^!\s*expect signal (\w*)/) {#expect signal SIGABRT if (defined($cmd{'cmd'})) { exec_cmd(\%cmd); @@ -522,7 +572,7 @@ print "hey\n"; $line =~ s/\r//g; setenv_cmd($line); } - elsif($line =~ /^!\s*include/){ #output sort + elsif($line =~ /^!\s*include/){ #include if (defined($cmd{'cmd'})) { exec_cmd(\%cmd); %cmd = (); @@ -572,6 +622,11 @@ foreach(@bg_cmds){ @bg_cmds=(); +if ($diff_tool) { + close $diff_tool_tmp_fh; + system("$diff_tool $diff_tool_tmp_filename $tesh_file"); + unlink $diff_tool_tmp_filename; +} if($error !=0){ exit $exitcode; @@ -610,7 +665,7 @@ 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()); @@ -621,14 +676,14 @@ sub build_diff { 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);