1: # feed this into perl 2 eval 'exec /usr/local/bin/perl -S $0 "$@"' 3 if $running_under_some_shell; 4 5# $Id: TEST,v 3.0.1.4 2001/03/17 18:14:23 ram Exp ram $ 6# 7# Copyright (c) 1990-2006, Raphael Manfredi 8# 9# You may redistribute only under the terms of the Artistic License, 10# as specified in the README file that comes with the distribution. 11# You may reuse parts of this distribution only within the terms of 12# that same Artistic License; a copy of which may be found at the root 13# of the source tree for mailagent 3.0. 14# 15# $Log: TEST,v $ 16# Revision 3.0.1.4 2001/03/17 18:14:23 ram 17# patch72: try to run tests as nobody when super-user -- from Debian 18# 19# Revision 3.0.1.3 1995/08/07 16:26:39 ram 20# patch37: added support for locking on filesystems with short filenames 21# 22# Revision 3.0.1.2 1994/09/22 14:40:10 ram 23# patch12: new -m option to monitor agentlog changes via atail 24# 25# Revision 3.0.1.1 1993/12/15 09:04:45 ram 26# patch3: now force . into PATH for msend/nsend 27# 28# Revision 3.0 1993/11/29 13:49:22 ram 29# Baseline for mailagent 3.0 netwide release. 30# 31 32if ($> == 0) { 33 print "Oh, you naughty person. You are superuser!\n"; 34 my $uid = (stat('.'))[4]; 35 $uid = (getpwnam('nobody'))[2] unless $uid; 36 $uid || die "Cannot run tests as super-user.[$<,$>]\n"; 37 $> = $uid; 38 $< = $uid; 39 my $whom = (getpwuid($uid))[0]; 40 print "Trying to run as user $whom [$uid]\n"; 41} 42 43chop($pwd = `pwd`); 44$ENV{'HOME'} = "$pwd/out"; 45chop($host = `(hostname 2>/dev/null || uname -n) 2>/dev/null`); 46$host =~ s/^([^.]*)\..*/$1/; # Trim domain name 47$ENV{'HOST'} = $host; 48$ENV{'USER'} = 'nobody'; # In case we get mails back from RUN and friends 49$ENV{'PWD'} = $pwd; 50$ENV{'LEVEL'} = 0; # Default loglvl for filter and cmd tests 51delete $ENV{'ENV'}; # For ksh 52&read_config_sh; # Load configuration into package cfsh 53$ENV{'LOCKEXT'} = $cfsh'd_flexfnam eq 'define' ? '.lock' : '!'; 54 55@tests = ('basic', 'option', 'filter', 'cmd', 'misc'); 56$failed = 0; 57$how_many = 0; 58 59require './getopt.pl'; 60&Getopt; 61 62$mailagent = 'mailagent'; # Default program (dataloaded version) 63$mailagent = 'magent' if $opt_n; # Use non-dataloaded version 64$ENV{'MAILAGENT'} = $mailagent; 65$ENV{'PATH'} = "$pwd/..:.:" . $ENV{'PATH'}; 66 67-f "../$mailagent" && -x _ || die "No $mailagent.\n"; 68-f '../filter/filter' && -x _ || die "No filter.\n"; 69$> || die "Cannot run tests as super-user. [$<,$>]\n"; 70 71&load_ok; # Don't rerun successful tests if up to date 72 73# A level file indicates default loglvl 74if (-f 'level') { 75 chop($level = `cat level`); 76 $ENV{'LEVEL'} = int($level); 77} 78 79# Launch atail if -m to monitor the agentlog file 80if ($opt_m) { 81 $atail_pid = fork; 82 unlink 'out/agentlog'; 83 if (defined $atail_pid && $atail_pid == 0) { 84 # Child process 85 exec 'perl ./atail'; 86 die "TEST: could not launch atail: $!\n"; 87 } 88} 89 90unless (-f 'OK') { 91 %Ok = (); 92 `rm -rf out` if -d 'out'; 93} 94 95umask 022; # Ensure none of the files are world writable 96 97`mkdir out` unless -d 'out'; 98 99select(STDOUT); 100$| = 1; 101 102# If they specified a list of files, run them and do not update "OK" 103# nor print any summary status. 104 105if (@ARGV) { 106 foreach my $file (@ARGV) { 107 run_file($file); 108 exit(1) if $failed && $opt_s; 109 } 110 exit($failed ? 1 : 0) ; 111} 112 113open(OK, ">>OK"); 114select(OK); 115$| = 1; # We may safely interrupt 116select(STDOUT); 117 118foreach $dir (@tests) { 119 next unless -d $dir; 120 &run($dir); 121} 122 123# Summarize what happened 124 125close OK; 126 127if ($failed == 0) { 128 print "All tests successful.\n"; 129} else { 130 print "Failed $how_many test", $how_many == 1 ? '' : 's'; 131 print " from $failed file", $failed == 1 ? '' : 's', ".\n"; 132} 133 134&clean_up; 135&exit(0); # End of tests 136 137# 138# Subroutines 139# 140 141sub exit { 142 local($code) = @_; 143 kill(15, $atail_pid) if $atail_pid; 144 exit $code; 145} 146 147sub clean_up { 148 return if $failed || $opt_i; # -i asks for incrementality 149 unlink 'OK'; 150 `rm -rf out` if -d 'out'; 151} 152 153sub print { 154 local($dir, $file) = @_; 155 $file =~ s/\.t$//; 156 local($len) = 1 + length($dir) + length($file); 157 print "$dir/$file", '.' x (17 - $len); 158} 159 160sub num { $a <=> $b; } 161 162sub result { 163 local($test, $output) = @_; 164 local($now) = time; 165 local(@res) = split(/\n/, $output); # Failed test numbers 166 if ($res[0] eq '') { 167 print "FAILED (no test run)\n"; 168 ++$failed; 169 } elsif ($res[$#res] == 0 && $#res > 0 && $res[$#res -1] == $#res) { 170 print "FAILED (all tests)\n"; 171 ++$failed; 172 $how_many += $#res; 173 } elsif ($res[0] == 0) { 174 print "ok\n"; 175 print OK "$test $now\n"; 176 } elsif ($res[0] == -1) { 177 print "untested\n"; 178 } else { 179 # Program outputs the number of each test failed, and last must be 0 180 local($last) = pop(@res); 181 push(@res, $last) unless $last == 0; 182 local($n) = @res + 0; 183 local($s) = $n == 1 ? '' : 's'; 184 print "FAILED ($n test$s:"; 185 @res = sort num @res; 186 print ' ', join(',', @res); 187 print " and aborted" unless $last == 0; 188 print ")\n"; 189 ++$failed; 190 $how_many += $n; 191 } 192 if ($failed && $opt_s) { # Stop at first error if -s 193 print "Aborted tests.\n"; 194 &exit(0); 195 } 196} 197 198sub run { 199 local($dir) = @_; 200 chdir $dir or die "Cannot chdir to $dir: $!\n"; 201 local(@files) = <*.t>; 202 local($test); 203 local($output); 204 foreach $file (@files) { 205 &print($dir, $file); 206 $test = "$dir/$file"; 207 if ($Ok{$test} >= ((stat($file))[9])) { # Check time stamp 208 print "done\n"; 209 next; 210 } 211 $output = `perl $file`; 212 &result($test, $output); 213 &basic_failed if $dir eq 'basic' && $failed; 214 } 215 chdir '..' or die "Cannot chdir back to ..: $!\n"; 216} 217 218sub run_file { 219 my ($path) = @_; 220 my ($dir, $file) = $path =~ m|^(.*)/(.*)|; 221 my $test = "$dir/$file"; 222 unless (-f $test) { 223 warn "WARNING: ignoring missing $path\n"; 224 return; 225 } 226 &print($dir, $file); 227 chdir $dir or die "Cannot chdir to $dir: $!\n"; 228 $output = `perl $file`; 229 &result($test, $output); 230 chdir $pwd or die "Cannot chdir back to ..: $!\n"; 231} 232 233sub basic_failed { 234 print "Failed a basic test, cannot continue.\n"; 235 unlink 'OK'; 236 &exit(0); 237} 238 239sub load_ok { 240 return unless -f 'OK'; 241 242 # Make sure the OK file is up to date, unless -o (outdated) 243 unless ($opt_o) { 244 local($ok_mtime) = (stat('OK'))[9]; 245 local($ma_mtime) = (stat("../$mailagent"))[9]; 246 local($fi_mtime) = (stat('../filter/filter'))[9]; 247 local($restart) = 0; 248 if ($ma_mtime > $ok_mtime) { 249 warn "Mailagent has changed, restarting tests...\n"; 250 ++$restart; 251 } elsif ($fi_mtime > $ok_mtime) { 252 warn "Filter has changed, restarting tests...\n"; 253 ++$restart; 254 } 255 unlink 'OK' if $restart; 256 } 257 258 return unless -f 'OK'; 259 local($file, $when); 260 open(OK, 'OK') || return; 261 while (<OK>) { 262 chop; 263 ($file, $when) = /^(\S+)\s+(\d+)/; 264 $Ok{$file} = $when if $when; 265 } 266 close OK; 267 268} 269 270# Read configuration information from config.sh 271sub read_config_sh { 272 open(CONFIG, '../../config.sh') || 273 die "No config.sh at the toplevel directory! Did you run Configure?\n"; 274 local($_); 275 local($config) = "package cfsh;\n"; 276 local($var, $value); 277 while (<CONFIG>) { 278 next unless ($var, $value) = /^(\w+)='([^']*)'/; 279 $config .= "\$$var = '$value';\n"; 280 } 281 close CONFIG; 282 eval($config); 283 warn $@ if $@; 284 die "Can't create config from config.sh\n" if $@; 285} 286 287