runtests.pl 5.05 KB
Newer Older
1
#!/usr/bin/env perl
Magali Ruffier's avatar
Magali Ruffier committed
2
# Copyright [1999-2015] Wellcome Trust Sanger Institute and the EMBL-European Bioinformatics Institute
premanand17's avatar
premanand17 committed
3
# Copyright [2016-2018] EMBL-European Bioinformatics Institute
4 5 6 7 8 9 10 11 12 13 14 15 16
# 
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
# 
#      http://www.apache.org/licenses/LICENSE-2.0
# 
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.

17 18 19 20

use strict;
use warnings;

21
use File::Basename;
22 23
use File::Find;
use File::Spec;
24
use Getopt::Long;
25
use TAP::Harness;
Andy Yates's avatar
Andy Yates committed
26

27 28 29
my $opts = {
  clean => 0,
  help => 0,
30
  skip => [],
31 32
  verbose => 0
};
33
my @args = ('clean|clear|c', 'help|h', 'verbose|v', 'list|tests|list-tests|l', 'skip=s@');
Andy Yates's avatar
Andy Yates committed
34

35 36 37 38 39 40
my $parse = GetOptions($opts, @args);
if(!$parse) {
  print STDERR "Could not parse the given arguments. Please consult the help\n";
  usage();
  exit 1;
} 
Andy Yates's avatar
Andy Yates committed
41

42 43
# If we were not given a directory as an argument, assume current directory
push(@ARGV, File::Spec->curdir()) if ! @ARGV;
44

45 46 47 48
# Print usage on '-h' command line option
if ($opts->{help}) {
  usage();
  exit;
49 50
}

51 52 53 54 55 56 57 58
# Get the tests
my $input_files_directories = [@ARGV];
my @tests = eval {
  get_all_tests($input_files_directories);
};
if($@) {
  printf(STDERR "Could not continue processing due to error: %s\n", $@);
  exit 1;
Andy Yates's avatar
Andy Yates committed
59
}
60

61
#Tests without cleans
62
my @no_clean_tests = sort grep { $_ !~ /CLEAN\.t$/ } @tests;
63

64 65 66 67 68 69
if (@{$opts->{skip}}) {
  my %skip = map { basename($_) => 1 } split(/,/, join(',', @{$opts->{skip}}));
  printf STDERR "Skipping tests: %s\n", join(', ', sort keys %skip);
  @no_clean_tests = grep { not $skip{basename($_)} } @no_clean_tests;
}

70
# List test files on '-l' command line option
71 72 73
if ($opts->{list}) {
  print "$_\n" for @no_clean_tests;
  exit;
74
}
75

76 77 78 79 80 81
# Make sure proper cleanup is done if the user interrupts the tests
$SIG{'HUP'} = $SIG{'KILL'} = $SIG{'INT'} = sub { 
  warn "\n\nINTERRUPT SIGNAL RECEIVED\n\n";
  clean();
  exit;
};
82

83
# Harness
84
my $harness = TAP::Harness->new({verbosity => $opts->{verbose}});
Andy Yates's avatar
Andy Yates committed
85

86 87
# Set environment variables
$ENV{'RUNTESTS_HARNESS'} = 1;
Andy Yates's avatar
Andy Yates committed
88

89
# Run all specified tests
90
my $results;
91
eval {
92
  $results = $harness->runtests(@no_clean_tests);
93 94
};

95
clean();
Andy Yates's avatar
Andy Yates committed
96

97
if($results->has_errors()) {
Andy Yates's avatar
Andy Yates committed
98
  my $count = $results->failed();
99 100 101
  $count   += $results->parse_errors();
  $count   += $results->exit();
  $count   += $results->wait();
102 103 104 105
  $count = 255 if $count > 255;
  exit $count;
}

106
sub usage {
107 108 109 110 111
    print <<EOT;
Usage:
\t$0 [-c] [-v] [<test files or directories> ...]
\t$0 -l        [<test files or directories> ...]
\t$0 -h
112

113 114 115
\t-l|--list|--tests|--list-tests\n\t\tlist available tests
\t-c|--clean|--clear\n\t\trun tests and clean up in each directory
\t\tvisited (default is not to clean up)
116
\t--skip <test_name>[,<test_name>...]\n\t\tskip listed tests
117 118
\t-v|--verbose\n\t\tbe verbose
\t-h|--help\n\t\tdisplay this help text
119 120

If no directory or test file is given on the command line, the script
121
will assume the current directory.
122
EOT
123 124 125 126 127 128 129 130 131 132 133 134 135 136 137
}

=head2 get_all_tests

  Description: Returns a list of testfiles in the directories specified by
               the @tests argument.  The relative path is given as well as
               with the testnames returned.  Only files ending with .t are
               returned.  Subdirectories are recursively entered and the test
               files returned within them are returned as well.
  Returntype : listref of strings.
  Exceptions : none
  Caller     : general

=cut

138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153
sub get_all_tests {
  my @files;
  my @out;

  #If we had files use them
  if ( $input_files_directories && @{$input_files_directories} ) {
    @files = @{$input_files_directories};
  }
  #Otherwise use current directory
  else {
    push(@files, File::Spec->curdir());
  }

  my $is_test = sub {
    my ($suspect_file) = @_;
    return 0 unless $suspect_file =~ /\.t$/;
154
    return 0 if $suspect_file =~ /^\./;
155 156
    if(! -f $suspect_file) {
      warn "Cannot find file '$suspect_file'";
157
    }
158 159
    elsif(! -r $suspect_file) {
      warn "Cannot read file '$suspect_file'";
160
    }
161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178
    return 1;
  };

  while (my $file = shift @files) {
    #If it was a directory use it as a point to search from
    if(-d $file) {
      my $dir = $file;
      #find cd's to the dir in question so use relative for tests
      find(sub {
        if( $_ ne '.' && $_ ne '..' && $_ ne 'CVS') {
          if($is_test->($_)) {
            push(@out, $File::Find::name);
          }
        } 
      }, $dir);
    }
    #Otherwise add it if it was a test
    else {
Andy Yates's avatar
Andy Yates committed
179
      push(@out, $file) if $is_test->($file);
180
    }
181
  }
182

183
  return @out;
184 185
}

186 187 188 189 190 191 192
sub clean {
  # Unset environment variable indicating final cleanup should be
  # performed
  delete $ENV{'RUNTESTS_HARNESS'};
  if($opts->{clean}) {
    my @new_tests = get_all_tests();
    my @clean_tests = grep { $_ =~ /CLEAN\.t$/ } @new_tests;
193
    eval { $harness->runtests(@clean_tests); };
194 195 196
    warn $@ if $@;
  }
  return;
197
}