#!/usr/bin/perl # # Run all defined tests. # use strict; use warnings; use Cwd; use Getopt::Long qw(:config no_ignore_case bundling); use Pod::Usage; # Option parsing. my $help; my $timeout = 5 * 60; my @include; my @exclude; my @include_dir; my $valgrind; GetOptions ( 'help|h' => \$help, 'timeout|t=i' => \$timeout, 'include|I=s' => \@include, 'exclude|X=s' => \@exclude, 'directory|d=s' => \@include_dir, 'valgrind|v' => \$valgrind, ) or pod2usage (2); pod2usage (1) if $help; @ARGV == 1 or pod2usage (2); my $base = getcwd . '/' . shift @ARGV; my %include; @include{@include} = (); my %exclude; @exclude{@exclude} = (); # Initialise signal number to name table. use Config; my @signame; my %signum;; my $i = 0; defined $Config{sig_name} || die "No sigs?"; foreach (split (' ', $Config{sig_name})) { $signame[$i] = $_; $signum{$_} = $i; $i++; } # Test macros. my %macros = ( 'cov' => \&cov_macro, 'cov-target' => \&cov_target_macro, 'valgrind' => \&valgrind_macro, ); my $lcov; # Read tests file. my $dir; my $skip; my $fail = 0; my $fail_expected = 0; my $tests = 0; while () { chomp; # Drop comments. next if /^\s*(?:#.*)?$/; # This table will enable an unget system to fake input lines. my @ungeted; push @ungeted, $_; while (@ungeted) { $_ = shift @ungeted; if (/^(.*?):(:)?$/) { # Directory line. $dir = $1; $skip = 0; unless (chdir "$base/$dir") { $fail++; my $t = "=> $dir"; print "\n$t\n=$t: FAIL cannot change directory\n"; $skip = 1; } # Push automatic clean test. push @ungeted, '-clean: make -s clean' unless $2; } elsif (!$skip) { # Test line. defined $dir or die "bad format"; # Read '-' and '!' flags. my ($dontcare, $expected) = (0, ''); $dontcare = 1 if s/^-//; $expected = ' (expected)' if s/^!//; # Decode name and command. my ($name, $cmd); /^(.*?): (.*)$/ and ($name, $cmd) = ($1, $2) or ($name, $cmd) = ($_, $_); # Decode macros. $name =~ /^(.*?) (.*)$/ && exists $macros{$1} and ($name, $cmd) = $macros{$1} ($1, $2, $cmd); # Skip test? next if @include_dir && !grep { $dir =~ /^$_/ } @include_dir; next if %include && !exists $include{$name}; next if exists $exclude{$name}; # Start test. my $t = "=> $dir - $name"; print "\n$t\n"; my $status = timed_system ($cmd); # Check result. if ($dontcare) { print "=$t: DONE\n"; } else { $tests++; if ($status != 0) { if ($expected) { $fail_expected++; } else { $fail++; } if ($status == -1 || $status == 128 << 8) { print "=$t: FAIL$expected command not found\n"; } elsif ($status & 127) { printf "=$t: FAIL$expected killed with signal %s\n", $signame[$status & 127]; die "interrupted" if ($signame[$status & 127] eq 'INT'); } else { printf "=$t: FAIL$expected exited with value %d\n", ($status >> 8); } } else { print "=$t: PASS\n"; } } } } } # Print summary. if ($fail && $fail_expected) { print "\n===> FAIL $fail unexpected tests (out of $tests, fail " . "$fail_expected tests as expected)\n"; } elsif ($fail) { print "\n===> FAIL $fail tests (out of $tests)\n"; } elsif ($fail_expected) { print "\n===> PASS almost all tests (but fail $fail_expected tests as " . "expected, out of $tests tests)\n"; } else { print "\n===> PASS all $tests tests\n"; } exit $fail ? 1 : 0; sub cov_macro { my ($name, $arg, $cmd, $objdir, $gcov) = @_; if (not defined $lcov) { system ('lcov --version > /dev/null'); $lcov = $? == 0 ? 1 : 0; } if ($lcov) { $objdir = 'obj' unless defined $objdir; $gcov = '' unless defined $gcov; return ($name, "rm -f obj/$arg.info && " . "lcov -q -d $objdir -b . -z $gcov && " . "$cmd && " . "lcov -q -d $objdir -b . -c -t $arg -o obj/$arg.info $gcov"); } else { return ('run', $cmd); } } sub cov_target_macro { my ($name, $arg, $cmd) = @_; if (exists $ENV{CROSS_COMPILE_}) { return cov_macro ($name, $arg, $cmd, '.', " -g $ENV{CROSS_COMPILE_}gcov"); } else { return ('run', $cmd); } } sub valgrind_macro { my ($name, $arg, $cmd) = @_; if ($valgrind) { return ('run', "valgrind $cmd"); } else { return ('run', $cmd); } } sub timed_system { pipe READEND, WRITEEND; my $cmd = shift; my $pid = fork; defined $pid or die "fork: $!,"; if ($pid == 0) { # Son. setpgrp ($$, $$); close WRITEEND; close STDIN; open (STDIN, "<&READEND"); exec $cmd; exit 128; } else { # Father. close READEND; eval { local $SIG{ALRM} = sub { die "alarm\n" }; alarm $timeout; do { $_ = wait } until $_ == $pid; alarm 0; }; if ($@) { die unless $@ eq "alarm\n"; kill INT => $pid; sleep 3; kill KILL => -$pid; print "Timed out!\n"; return $signum{ALRM}; } else { return $?; } } } __END__ =head1 NAME run-test.pl - Read a tests file and run all configured tests =head1 SYNOPSIS run-test.pl [options] base Options: -h, --help brief help message -I, --include=NAME only include named tests, can be issued multiple times -X, --exclude=NAME do not include named tests -d, --directory=DIR only include tests below given directories -t, --timeout=SEC timeout for each test (seconds) -v, --valgrind use valgrind to track memory issues =cut