buildtools/Cmake/tesh.pl

   1 #! /usr/bin/perl
   2 eval 'exec perl -S $0 ${1+"$@"}'
   3     if $running_under_some_shell;
   4
   5 =encoding UTF-8
   6
   7 =head1 NAME
   8
   9 tesh -- testing shell
  10
  11 =head1 SYNOPSIS
  12
  13 B<tesh> [I<options>] I<tesh_file>
  14
  15 =cut
  16 my($bindir);
  17 my($srcdir);
  18 my $path = $0;
  19 $path =~ s|[^/]*$||;
  20 push @INC,$path;
  21
  22 use Getopt::Long qw(GetOptions);
  23 use strict;
  24 use Term::ANSIColor;
  25 use IPC::Open3;
  26
  27 my($OS)=`echo %OS%`;
  28 if($OS eq "%OS%"){
  29         $OS = "UNIX";
  30 }
  31 else{
  32         $OS = "WIN";
  33 }
  34
  35 # make sure we received a tesh file
  36 scalar @ARGV > 0 || die "Usage:\n    tesh [*options*] *tesh_file*\n";
  37
  38 #Add current directory to path
  39 $ENV{PATH} = "$ENV{PATH}:.";
  40
  41
  42 ##
  43 ## Command line option handling
  44 ##
  45
  46 # option handling helper subs
  47 sub cd_cmd {
  48     my $directory=$_[1];
  49     if (-e $directory && -d $directory) {
  50         chdir("$directory");
  51         print "[Tesh/INFO] change directory to $directory\n";
  52     } elsif (-e $directory) {
  53         die "[Tesh/CRITICAL] Cannot change directory to '$directory': it is not a directory\n";
  54     } else {
  55         die "[Tesh/CRITICAL] Cannot change directory to '$directory': no such directory\n";
  56     }
  57 }
  58
  59 sub setenv_cmd {
  60     if ($_[1] =~ /^(.*)=(.*)$/) {
  61         my($var,$ctn)=($1,$2);
  62
  63         if($var =~ /bindir/){
  64                 print "[Tesh/INFO] setenv $var=$ctn\n";
  65                 $bindir = $ctn;
  66         }
  67         else
  68         {
  69                 if($var =~ /srcdir/){
  70                         $srcdir = $ctn;
  71                 }
  72                 else{
  73                         $ENV{$var} = $ctn;
  74                         print "[Tesh/INFO] setenv $var=$ctn\n";
  75                 }
  76         }
  77         } else {
  78         die "[Tesh/CRITICAL] Malformed argument to setenv: expected 'name=value' but got '$_[1]'\n";
  79     }
  80 }
  81
  82 # Main option parsing sub
  83 my $tesh_file;
  84 sub get_options {
  85     # remove the tesh file from the ARGV used
  86     my @ARGV = @_;
  87     $tesh_file = pop @ARGV;
  88
  89     # temporary arrays for GetOption
  90     my @verbose = ();
  91     my @cfg;
  92     my $log; # ignored
  93
  94     my %opt = (
  95         "help"    => 0,
  96         "debug"   => 0,
  97         "verbose" => 0
  98         );
  99
 100     Getopt::Long::config('bundling', 'no_getopt_compat', 'no_auto_abbrev');
 101
 102     GetOptions(
 103         'help|h'     => \$opt{'help'},
 104
 105         'verbose|v'  => \@verbose,
 106         'debug|d'    => \$opt{"debug"},
 107
 108         'cd=s'       => \&cd_cmd,
 109         'setenv=s'   => \&setenv_cmd,
 110         'cfg=s'      => \@cfg,
 111         'log=s'      => \$log,
 112         );
 113
 114     $opt{'verbose'} = scalar @verbose;
 115     foreach (@cfg) {
 116         $opt{'cfg'} .= " --cfg=$_";
 117     }
 118     return %opt;
 119 }
 120
 121 my %opts = get_options(@ARGV);
 122
 123 ##
 124 ## File parsing
 125 ##
 126 my($sort)=0;
 127 my($nb_arg)=0;
 128 my($timeout)=0;
 129 my($old_buffer);
 130 my($linebis);
 131 my($SIGABRT)=0;
 132 my($no_output_ignore)=1;
 133 my($verbose)=0;
 134 my($return)=-1;
 135 my($pid);
 136 my($result);
 137 my($result_err);
 138 my($forked);
 139 my($config)="";
 140
 141 my($tesh_command)=0;
 142 my(@buffer_tesh)=();
 143
 144 eval {
 145     use POSIX;
 146     sub exit_status {
 147         my $status = shift;
 148         if (POSIX::WIFEXITED($status)) {
 149             return "returned code ".POSIX::WEXITSTATUS($status);
 150         } elsif (POSIX::WIFSIGNALED($status)) {
 151             return "got signal ".$SIG{POSIX::WTERMSIG($status)};
 152         }
 153         return "Unparsable status. Is the process stopped?";
 154     }
 155 };
 156 if ($@) { # no POSIX available?
 157     warn "POSIX not usable to parse the return value of forked child: $@\n";
 158     sub exit_status {
 159         return "returned code 0";
 160     }
 161 }
 162
 163 sub exec_cmd {
 164     my %cmd = %{$_[0]};
 165     if ($opts{'debug'}) {
 166         print "IN BEGIN\n";
 167         map {print "  $_"} @{$cmd{'in'}};
 168         print "IN END\n";
 169         print "OUT BEGIN\n";
 170         map {print "  $_"} @{$cmd{'out'}};
 171         print "OUT END\n";
 172         print "CMD: $cmd{'cmd'}\n";
 173     }
 174
 175     # cleanup the command line
 176     if($OS eq "WIN"){
 177                 $cmd{'cmd'} =~ s/\${EXEEXT:=}/.exe/g;
 178         }
 179         else{
 180                 $cmd{'cmd'} =~ s/\${EXEEXT:=}//g;
 181         }
 182     $cmd{'cmd'} =~ s/\${bindir:=}/$bindir/g;
 183     $cmd{'cmd'} =~ s/\${srcdir:=}/$srcdir/g;
 184     $cmd{'cmd'} =~ s/\${bindir:=.}/$bindir/g;
 185     $cmd{'cmd'} =~ s/\${srcdir:=.}/$srcdir/g;
 186     $cmd{'cmd'} =~ s/\${bindir}/$bindir/g;
 187     $cmd{'cmd'} =~ s/\${srcdir}/$srcdir/g;
 188     $cmd{'cmd'} =~ s|^\./||g;
 189 #    $cmd{'cmd'} =~ s|tesh|tesh.pl|g;
 190     $cmd{'cmd'} =~ s/\(%i:%P@%h\)/\\\(%i:%P@%h\\\)/g;
 191     $cmd{'cmd'} .= " $opts{'cfg'}" if (defined($opts{'cfg'}) && length($opts{'cfg'}));
 192
 193     print "[$cmd{'file'}:$cmd{'line'}] $cmd{'cmd'}\n";
 194
 195     ###
 196     # exec the command line
 197     ###
 198     $pid = open3(\*IN, \*OUT, \*OUT, $cmd{'cmd'} );
 199
 200     # if timeout specified, fork and kill executing child at the end of timeout
 201     if ($timeout){
 202         $forked = fork();
 203         die "fork() failed: $!" unless defined $forked;
 204         if ( $forked == 0 ) { # child
 205             sleep $timeout;
 206             kill(9, $pid);
 207             exit;
 208         }
 209     }
 210
 211     # push all provided input to executing child
 212     map { print IN "$_\n" } $cmd{'in'};
 213     close IN;
 214
 215     # pop all output from executing child
 216     my @got;
 217     while(defined(my $got=<OUT>)) {
 218         $got =~ s/\r//g;
 219         $got =~ s/^( )*//g;
 220         chomp $got;
 221         push @got, "$got";
 222     }
 223     close OUT;
 224
 225     # Cleanup the executing child, and kill the timeouter brother on need
 226     $cmd{'return'} = 0 unless defined($cmd{'return'});
 227     my $wantret = "returned code ".(defined($cmd{'return'})? $cmd{'return'} : 0);
 228     waitpid ($pid, 0);
 229     my $gotret = exit_status($?);
 230     if($gotret ne $wantret) {
 231         my $msg = "Test suite `$cmd{'file'}': NOK (<$cmd{'file'}:$cmd{'line'}> $gotret)\n".
 232             "Output of <$cmd{'file'}:$cmd{'line'}> so far:\n";
 233         map {$msg .=  "|| $_\n"} @got;
 234         print STDERR "$msg";
 235         exit(1);
 236     }
 237     if($timeout){kill(9, $forked);$timeout=0;}
 238     $timeout = 0;
 239
 240     ###
 241     # Check the result of execution
 242     ###
 243     my $diff = build_diff(\@{$cmd{'out'}}, \@got);
 244     if (length $diff) {
 245         print color("red")."[TESH/CRITICAL$$] Output mismatch\n";
 246         map { print "[TESH/CRITICAL] $_\n" } split(/\n/,$diff);
 247         print color("reset");
 248         die "Tesh failed\n";
 249     }
 250 }
 251
 252 sub mkfile_cmd {
 253     my %cmd = %{$_[0]};
 254     my $file = $cmd{'arg'};
 255     print "[Tesh/INFO] mkfile $file\n";
 256
 257     die "[TESH/CRITICAL] no input provided to mkfile\n" unless defined($cmd{'in'}) && scalar @{$cmd{'in'}};
 258     unlink($file);
 259     open(FILE,">$file") or die "[Tesh/CRITICAL] Unable to create file $file: $!\n";
 260     print FILE join("\n", @{$cmd{'in'}});
 261     print FILE "\n" if (scalar @{$cmd{'in'}} > 0);
 262     close(FILE);
 263 }
 264
 265 # parse tesh file
 266 print "Test suite $tesh_file\n";
 267 open TESH_FILE, $tesh_file or die "[Tesh/CRITICAL] Unable to open $tesh_file $!\n";
 268
 269
 270 my %cmd; # everything about the next command to run
 271 my $line_num=0;
 272 LINE: while (defined(my $line=<TESH_FILE>)) {
 273     $line_num++;
 274     chomp $line;
 275     print "[TESH/debug] $line_num: $line\n" if $opts{'debug'};
 276
 277     # deal with line continuations
 278     while ($line =~ /^(.*?)\\$/) {
 279         my $next=<TESH_FILE>;
 280         die "[TESH/CRITICAL] Continued line at end of file\n"
 281             unless defined($next);
 282         chomp $next;
 283         print "[TESH/debug] $line_num: $next\n" if $opts{'debug'};
 284         $line = $1.$next;
 285     }
 286
 287     # Push delayed commands on empty lines
 288     unless ($line =~ m/^(..)(.*)$/) {
 289         if (defined($cmd{'cmd'})) {
 290             exec_cmd(\%cmd);
 291             %cmd = ();
 292         }
 293         next LINE;
 294     }
 295
 296     my ($cmd,$arg) = ($1,$2);
 297     $arg =~ s/\r//g;
 298
 299     # handle the commands
 300     if ($cmd =~ /^#/) { #comment
 301     } elsif ($cmd eq '> '){     #expected result line
 302         print "[TESH/debug] push expected result\n" if $opts{'debug'};
 303         push @{$cmd{'out'}}, $arg;
 304
 305     } elsif ($cmd eq '< ') {    # provided input
 306         print "[TESH/debug] push provided input\n" if $opts{'debug'};
 307         push @{$cmd{'in'}}, $arg;
 308
 309     } elsif ($cmd eq 'p ') {    # comment
 310         print "[Tesh/INFO] $arg\n";
 311
 312     } elsif ($cmd eq '$ ') {  # Command
 313         # if we have something buffered, run it now
 314         if (defined($cmd{'cmd'})) {
 315             exec_cmd(\%cmd);
 316             %cmd = ();
 317         }
 318         if ($arg =~ /^ *mkfile /){      # "mkfile" command line
 319             die "[TESH/CRITICAL] Output expected from mkfile command!\n" if scalar @{cmd{'out'}};
 320
 321             $cmd{'arg'} = $arg;
 322             $cmd{'arg'} =~ s/ *mkfile //;
 323             mkfile_cmd(\%cmd);
 324             %cmd = ();
 325
 326         } elsif ($arg =~ /^ *cd /) {
 327             die "[TESH/CRITICAL] Input provided to cd command!\n" if scalar @{cmd{'in'}};
 328             die "[TESH/CRITICAL] Output expected from cd command!\n" if scalar @{cmd{'out'}};
 329
 330             $arg =~ s/^ *cd //;
 331             cd_cmd("",$arg);
 332             %cmd = ();
 333
 334         } else { # regular command
 335             $cmd{'cmd'} = $arg;
 336             $cmd{'file'} = $tesh_file;
 337             $cmd{'line'} = $line_num;
 338         }
 339     }
 340     elsif($cmd eq '& '){        # parallel command line
 341         $cmd{'background'} = 1;
 342         $cmd{'cmd'} = $arg;
 343     }
 344     elsif($line =~ /^! output sort/){   #output sort
 345         $cmd{'sort'} = 1;
 346     }
 347     elsif($line =~ /^! output ignore/){ #output ignore
 348         $cmd{'output ignore'} = 1;
 349     }
 350     elsif($line =~ /^! expect signal SIGABRT$/) {#expect signal SIGABRT
 351         $cmd{'expect'} = "SIGABRT";
 352     }
 353     elsif($line =~ /^! expect return/){ #expect return
 354         $line =~ s/^! expect return //g;
 355         $line =~ s/\r//g;
 356         $cmd{'return'} = $line;
 357     }
 358     elsif($line =~ /^! setenv/){        #setenv
 359         $line =~ s/^! setenv //g;
 360         $line =~ s/\r//g;
 361         setenv_cmd($line);
 362     }
 363     elsif($line =~ /^! include/){       #output sort
 364         print color("red"), "[Tesh/CRITICAL] need include";
 365         print color("reset"), "\n";
 366         die;
 367     }
 368     elsif($line =~ /^! timeout/){       #timeout
 369         $line =~ s/^! timeout //;
 370         $line =~ s/\r//g;
 371         $cmd{'timeout'} = $line;
 372     } else {
 373         die "[TESH/CRITICAL] parse error: $line\n";
 374     }
 375 }
 376
 377 # Deal with last command
 378 if (defined($cmd{'cmd'})) {
 379     exec_cmd(\%cmd);
 380     %cmd = ();
 381 }
 382
 383 #my (@a,@b);
 384 #push @a,"bl1";   push @b,"bl1";
 385 #push @a,"bl2";   push @b,"bl2";
 386 #push @a,"bl3";   push @b,"bl3";
 387 #push @a,"bl4";   push @b,"bl4";
 388 #push @a,"bl5";   push @b,"bl5";
 389 #push @a,"bl6";   push @b,"bl6";
 390 #push @a,"bl7";   push @b,"bl7";
 391 ##push @a,"Perl";  push @b,"ruby";
 392 #push @a,"END1";   push @b,"END1";
 393 #push @a,"END2";   push @b,"END2";
 394 #push @a,"END3";   push @b,"END3";
 395 #push @a,"END4";   push @b,"END4";
 396 #push @a,"END5";   push @b,"END5";
 397 #push @a,"END6";   push @b,"END6";
 398 #push @a,"END7";   push @b,"END7";
 399 #print "Identical:\n". build_diff(\@a,\@b);
 400
 401 #@a = (); @b =();
 402 #push @a,"AZE"; push @b,"EZA";
 403 #print "Different:\n".build_diff(\@a,\@b);
 404
 405 use Diff qw(diff); # postpone a bit to have time to change INC
 406
 407 sub build_diff {
 408     my $res;
 409     my $diff = Diff->new(@_);
 410
 411     $diff->Base( 1 );   # Return line numbers, not indices
 412     my $chunk_count = $diff->Next(-1); # Compute the amount of chuncks
 413     return ""     if ($chunk_count == 1 && $diff->Same());
 414     $diff->Reset();
 415     while(  $diff->Next()  ) {
 416         my @same = $diff->Same();
 417         if ($diff->Same() ) {
 418             if ($diff->Next(0) > 1) { # not first chunk: print 2 first lines
 419                 $res .= '  '.$same[0]."\n" ;
 420                 $res .= '  '.$same[1]."\n" if (scalar @same>1);
 421             }
 422             $res .= "...\n"  if (scalar @same>2);
 423 #       $res .= $diff->Next(0)."/$chunk_count\n";
 424             if ($diff->Next(0) < $chunk_count) { # not last chunk: print 2 last lines
 425                 $res .= '  '.$same[scalar @same -2]."\n" if (scalar @same>1);
 426                 $res .= '  '.$same[scalar @same -1]."\n";
 427             }
 428         }
 429         next if  $diff->Same();
 430         map { $res .= "- $_\n" } $diff->Items(1);
 431         map { $res .= "+ $_\n" } $diff->Items(2);
 432     }
 433     return $res;
 434 }
 435
 436