source: branches/stable/PERL_SCRIPTS/test/testScripts.pl

Last change on this file was 8318, checked in by westram, 9 years ago
  • repaired compile-tests for delivered perl-macros and -scripts
    • was broken by [6318]
    • now tests whether Lint/LintSubs? is installed
      • if not installed → accept failure
      • if installed → fail compilation if scripts do not compile
    • test whether Bioperl is installed
      • if not installed → accept failure on scripts in BIOPERL folder
      • if installed → fail compilation if scripts there do not compile
File size: 3.9 KB
Line 
1#!perl
2
3use strict;
4use warnings;
5
6my %dirOf = ();
7my $arbhome = undef;
8
9sub lookForScripts($\@\@);
10sub lookForScripts($\@\@) {
11  my ($dir,$scripts_r,$modules_r) = @_;
12  my @subdirs = ();
13
14  opendir(DIR,$dir) || die "can't read directory '$dir' (Reason: $!)";
15  foreach (readdir(DIR)) {
16    if ($_ ne '.' and $_ ne '..') {
17      my $full = $dir.'/'.$_;
18      if (-d $full) {
19        push @subdirs, $full;
20      }
21      elsif (/\.(pl|amc)$/io) { push @$scripts_r, $full; $dirOf{$_} = $dir; }
22      elsif (/\.pm$/io) { push @$modules_r, $full; $dirOf{$_} = $dir; }
23    }
24  }
25  closedir(DIR);
26  foreach (@subdirs) {
27    lookForScripts($_,@$scripts_r,@$modules_r);
28  }
29}
30
31sub convertErrors($) {
32  my ($lines) = @_;
33  my @lines = split("\n",$lines);
34  my $seen_error = 0;
35  my @out = ();
36  foreach (@lines) {
37    if (/ at (.*) line ([0-9]+)/o) {
38      my ($err,$name,$line,$rest) = ($`,$1,$2,$');
39      my $full = $dirOf{$name};
40      if (defined $full) {
41        $full .= '/'.$name;
42      }
43      else {
44        $full = $name;
45      }
46
47      my $msg = $full.':'.$line.': '.$err.$rest;
48      push @out, $msg;
49      $seen_error = 1;
50    }
51    else {
52      push @out, $_;
53    }
54  }
55
56  if ($seen_error==1) {
57    print " FAILED\n";
58    foreach (@out) { print $_."\n"; }
59  }
60  else {
61    print " OK"
62  }
63  return $seen_error;
64}
65
66sub splitDirName($) {
67  my ($file) = @_;
68  if ($file =~ /\/([^\/]+)$/o) {
69    my ($dir,$name) = ($`,$1);
70    return ($dir,$name);
71  }
72  die "can't split '$file'";
73}
74
75sub test_script($$) {
76  my ($script,$isModule) = @_;
77
78  my ($dir,$name) = splitDirName($script);
79  if (not chdir($dir)) { die "can't cd to '$dir' (Reason: $!)"; }
80
81  my @tests = (
82               '-c',
83               '-MO=LintSubs',
84               '-MO=Lint,no-regexp-variables',
85              );
86
87  print "Testing $name";
88  foreach (@tests) {
89    if ($isModule) { $_ = '-I'.$arbhome.'/lib '.$_; }
90    my $test = 'perl '.$_.' '.$name.' 2>&1';
91    # print "\ntest='$test'\n";
92    my $result = `$test`;
93    if (convertErrors($result)) {
94      return 0;
95    }
96  }
97  print "\n";
98  return 1;
99}
100
101my %failed_test = (); # scripts in this directory (key=failed script,value=1)
102my $failed_bioperl = 0; # script in BIOPERL directory
103my $failed_normal  = 0; # other scripts
104
105sub announce_failure($) {
106  my ($script) = @_;
107  if ($script =~ /\/PERL_SCRIPTS\/test\//) {
108    $failed_test{$'} = 1;
109  }
110  elsif ($script =~ /\/PERL_SCRIPTS\/BIOPERL\//) { $failed_bioperl++; }
111  else { $failed_normal++; }
112}
113
114sub main() {
115  $arbhome = $ENV{ARBHOME};
116  if (not defined $arbhome) { die "ARBHOME undefined"; }
117
118  my $script_root = $ENV{ARBHOME}.'/PERL_SCRIPTS';
119  my $macros_root = $ENV{ARBHOME}.'/lib/macros';
120  if (not -d $script_root) { die "No such directory '$script_root'"; }
121  if (not -d $macros_root) { die "No such directory '$macros_root'"; }
122
123  my @scripts = ();
124  my @modules = ();
125  lookForScripts($script_root,@scripts,@modules);
126  lookForScripts($macros_root,@scripts,@modules);
127
128  # print "Existing perl scripts:\n";
129  # foreach (@scripts) { print "- '$_'\n"; }
130
131  foreach (@modules) { if (test_script($_,1)==0) { announce_failure($_); } }
132  foreach (@scripts) { if (test_script($_,0)==0) { announce_failure($_); } }
133
134  $| = 1;
135
136  if (defined $failed_test{'check_lint.pl'}) {
137    print "Assuming Lint/LintSubs is not installed (cannot test whether perl modules compile)\n";
138  }
139  else {
140    my $failed = $failed_normal+$failed_bioperl;
141
142    if (defined $failed_test{'check_arb.pl'}) {
143      die "Fatal error: Failed to load ARB perl module\n";
144    }
145    if (defined $failed_test{'check_bioperl.pl'}) {
146      print "Assuming BIOPERL is not installed\n";
147      if ($failed_bioperl==0) {
148        die "but all BIOPERL scripts compiled - sth is completely wrong here\n";
149      }
150      print "accepting $failed_bioperl failing scripts that use BIOPERL\n";
151      $failed -= $failed_bioperl;
152    }
153    else {
154      print "Assuming BIOPERL is installed\n";
155    }
156
157    if ($failed>0) {
158      die "$failed scripts failed to compile\n";
159    }
160  }
161}
162main();
Note: See TracBrowser for help on using the repository browser.