2 eval 'exec perl -S $0 ${1+"$@"}'
3 if $running_under_some_shell;
13 B<tesh> [I<options>] I<tesh_file>
21 use Pod::Usage qw(pod2usage);
22 use Getopt::Long qw(GetOptions);
28 # make sure we received a tesh file
29 scalar @ARGV > 0 || pod2usage(-exitval => 1);
31 #Add current directory to path
32 $ENV{PATH} = "$ENV{PATH}:.";
36 ## Command line option handling
39 # option handling helper subs
42 if (-e $directory && -d $directory) {
44 print "[Tesh/INFO] change directory to $directory\n";
45 } elsif (-e $directory) {
46 die "[Tesh/CRITICAL] Cannot change directory to '$directory': it is not a directory\n";
48 die "[Tesh/CRITICAL] Cannot change directory to '$directory': no such directory\n";
53 if ($_[1] =~ /^(.*)=(.*)$/) {
54 my($var,$ctn)=($1,$2);
56 print "[Tesh/INFO] setenv $var=$ctn\n";
58 die "[Tesh/CRITICAL] Malformed argument to setenv: expected 'name=value' but got '$_[1]'\n";
62 # Main option parsing sub
65 # remove the tesh file from the ARGV used
67 $tesh_file = pop @ARGV;
69 # temporary arrays for GetOption
80 Getopt::Long::config('bundling', 'no_getopt_compat', 'no_auto_abbrev');
83 'help|h' => \$opt{'help'},
85 'verbose|v' => \@verbose,
86 'debug|d' => \$opt{"debug"},
89 'setenv=s' => \&setenv_cmd,
94 $opt{'verbose'} = scalar @verbose;
96 $opt{'cfg'} .= " --cfg=$_";
101 my %opts = get_options(@ARGV);
112 my($no_output_ignore)=1;
128 if (POSIX::WIFEXITED($status)) {
129 return "returned code ".POSIX::WEXITSTATUS($status);
130 } elsif (POSIX::WIFSIGNALED($status)) {
131 return "got signal ".$SIG{POSIX::WTERMSIG($status)};
133 return "Unparsable status. Is the process stopped?";
136 if ($@) { # no POSIX available?
137 warn "POSIX not usable to parse the return value of forked child: $@\n";
139 return "returned code 0";
145 if ($opts{'debug'}) {
147 map {print " $_"} @{$cmd{'in'}};
150 map {print " $_"} @{$cmd{'out'}};
152 print "CMD: $cmd{'cmd'}\n";
155 # cleanup the command line
156 $cmd{'cmd'} =~ s/\${EXEEXT:=}//g;
157 $cmd{'cmd'} =~ s|^\./||g;
158 # $cmd{'cmd'} =~ s|tesh|tesh.pl|g;
159 $cmd{'cmd'} =~ s/\(%i:%P@%h\)/\\\(%i:%P@%h\\\)/g;
160 $cmd{'cmd'} .= " $opts{'cfg'}" if (defined($opts{'cfg'}) && length($opts{'cfg'}));
162 print "[$cmd{'file'}:$cmd{'line'}] $cmd{'cmd'}\n";
165 # exec the command line
167 $pid = open3(\*IN, \*OUT, \*OUT, $cmd{'cmd'} );
169 # if timeout specified, fork and kill executing child at the end of timeout
172 die "fork() failed: $!" unless defined $forked;
173 if ( $forked == 0 ) { # child
180 # push all provided input to executing child
181 map { print IN "$_\n" } $cmd{'in'};
184 # pop all output from executing child
186 while(defined(my $got=<OUT>)) {
194 # Cleanup the executing child, and kill the timeouter brother on need
195 $cmd{'return'} = 0 unless defined($cmd{'return'});
196 my $wantret = "returned code ".(defined($cmd{'return'})? $cmd{'return'} : 0);
198 my $gotret = exit_status($?);
199 if($gotret ne $wantret) {
200 my $msg = "Test suite `$cmd{'file'}': NOK (<$cmd{'file'}:$cmd{'line'}> $gotret)\n".
201 "Output of <$cmd{'file'}:$cmd{'line'}> so far:\n";
202 map {$msg .= "|| $_\n"} @got;
206 if($timeout){kill(9, $forked);$timeout=0;}
210 # Check the result of execution
212 my $diff = build_diff(\@{$cmd{'out'}}, \@got);
214 print color("red")."[TESH/CRITICAL$$] Output mismatch\n";
215 map { print "[TESH/CRITICAL] $_\n" } split(/\n/,$diff);
216 print color("reset");
223 my $file = $cmd{'arg'};
224 print "[Tesh/INFO] mkfile $file\n";
226 die "[TESH/CRITICAL] no input provided to mkfile\n" unless defined($cmd{'in'}) && scalar @{$cmd{'in'}};
228 open(FILE,">$file") or die "[Tesh/CRITICAL] Unable to create file $file: $!\n";
229 print FILE join("\n", @{$cmd{'in'}});
230 print FILE "\n" if (scalar @{$cmd{'in'}} > 0);
235 print "Test suite $tesh_file\n";
236 open TESH_FILE, $tesh_file or die "[Tesh/CRITICAL] Unable to open $tesh_file $!\n";
239 my %cmd; # everything about the next command to run
241 LINE: while (defined(my $line=<TESH_FILE>)) {
244 print "[TESH/debug] $line_num: $line\n" if $opts{'debug'};
246 # deal with line continuations
247 while ($line =~ /^(.*?)\\$/) {
248 my $next=<TESH_FILE>;
249 die "[TESH/CRITICAL] Continued line at end of file\n"
250 unless defined($next);
252 print "[TESH/debug] $line_num: $next\n" if $opts{'debug'};
256 # Push delayed commands on empty lines
257 unless ($line =~ m/^(..)(.*)$/) {
258 if (defined($cmd{'cmd'})) {
265 my ($cmd,$arg) = ($1,$2);
268 # handle the commands
269 if ($cmd =~ /^#/) { #comment
270 } elsif ($cmd eq '> '){ #expected result line
271 print "[TESH/debug] push expected result\n" if $opts{'debug'};
272 push @{$cmd{'out'}}, $arg;
274 } elsif ($cmd eq '< ') { # provided input
275 print "[TESH/debug] push provided input\n" if $opts{'debug'};
276 push @{$cmd{'in'}}, $arg;
278 } elsif ($cmd eq 'p ') { # comment
279 print "[Tesh/INFO] $arg\n";
281 } elsif ($cmd eq '$ ') { # Command
282 # if we have something buffered, run it now
283 if (defined($cmd{'cmd'})) {
287 if ($arg =~ /^ *mkfile /){ # "mkfile" command line
288 die "[TESH/CRITICAL] Output expected from mkfile command!\n" if scalar @{cmd{'out'}};
291 $cmd{'arg'} =~ s/ *mkfile //;
295 } elsif ($arg =~ /^ *cd /) {
296 die "[TESH/CRITICAL] Input provided to cd command!\n" if scalar @{cmd{'in'}};
297 die "[TESH/CRITICAL] Output expected from cd command!\n" if scalar @{cmd{'out'}};
303 } else { # regular command
305 $cmd{'file'} = $tesh_file;
306 $cmd{'line'} = $line_num;
309 elsif($cmd eq '& '){ # parallel command line
310 $cmd{'background'} = 1;
313 elsif($line =~ /^! output sort/){ #output sort
316 elsif($line =~ /^! output ignore/){ #output ignore
317 $cmd{'output ignore'} = 1;
319 elsif($line =~ /^! expect signal SIGABRT$/) {#expect signal SIGABRT
320 $cmd{'expect'} = "SIGABRT";
322 elsif($line =~ /^! expect return/){ #expect return
323 $line =~ s/^! expect return //g;
325 $cmd{'return'} = $line;
327 elsif($line =~ /^! setenv/){ #setenv
328 $line =~ s/^! setenv //g;
332 elsif($line =~ /^! include/){ #output sort
333 print color("red"), "[Tesh/CRITICAL] need include";
334 print color("reset"), "\n";
337 elsif($line =~ /^! timeout/){ #timeout
338 $line =~ s/^! timeout //;
340 $cmd{'timeout'} = $line;
342 die "[TESH/CRITICAL] parse error: $line\n";
346 # Deal with last command
347 if (defined($cmd{'cmd'})) {
353 #push @a,"bl1"; push @b,"bl1";
354 #push @a,"bl2"; push @b,"bl2";
355 #push @a,"bl3"; push @b,"bl3";
356 #push @a,"bl4"; push @b,"bl4";
357 #push @a,"bl5"; push @b,"bl5";
358 #push @a,"bl6"; push @b,"bl6";
359 #push @a,"bl7"; push @b,"bl7";
360 ##push @a,"Perl"; push @b,"ruby";
361 #push @a,"END1"; push @b,"END1";
362 #push @a,"END2"; push @b,"END2";
363 #push @a,"END3"; push @b,"END3";
364 #push @a,"END4"; push @b,"END4";
365 #push @a,"END5"; push @b,"END5";
366 #push @a,"END6"; push @b,"END6";
367 #push @a,"END7"; push @b,"END7";
368 #print "Identical:\n". build_diff(\@a,\@b);
371 #push @a,"AZE"; push @b,"EZA";
372 #print "Different:\n".build_diff(\@a,\@b);
374 use Diff qw(diff); # postpone a bit to have time to change INC
378 my $diff = Diff->new(@_);
380 $diff->Base( 1 ); # Return line numbers, not indices
381 my $chunk_count = $diff->Next(-1); # Compute the amount of chuncks
382 return "" if ($chunk_count == 1 && $diff->Same());
384 while( $diff->Next() ) {
385 my @same = $diff->Same();
386 if ($diff->Same() ) {
387 if ($diff->Next(0) > 1) { # not first chunk: print 2 first lines
388 $res .= ' '.$same[0]."\n" ;
389 $res .= ' '.$same[1]."\n" if (scalar @same>1);
391 $res .= "...\n" if (scalar @same>2);
392 # $res .= $diff->Next(0)."/$chunk_count\n";
393 if ($diff->Next(0) < $chunk_count) { # not last chunk: print 2 last lines
394 $res .= ' '.$same[scalar @same -2]."\n" if (scalar @same>1);
395 $res .= ' '.$same[scalar @same -1]."\n";
398 next if $diff->Same();
399 map { $res .= "- $_\n" } $diff->Items(1);
400 map { $res .= "+ $_\n" } $diff->Items(2);