If a test doesn't finish in 2 minutes, consider it faulty.
[mono.git] / mono / tests / test-driver
1 #!/usr/bin/env perl
2
3 my $interpreter = shift;
4 my $test = shift;
5 my $disabled_tests = shift;
6 my $output = $test;
7 my $stdout = $test.'.stdout';
8 my $stderr = $test.'.stderr';
9
10 $output =~ s/\.exe$/.output/;
11
12 $| = 0;
13 print "Testing $test... ";
14
15 foreach $disabled (split (/ /, $disabled_tests)) {
16         if ($disabled eq $test) {
17                 print "disabled.\n";
18                 exit (0);
19         }
20 }
21
22 my $res;
23 my $cpid = fork ();
24 if (!defined ($cpid)) {
25         $res = system("$interpreter @ARGV $test 2>$stderr 1>$stdout");
26 } elsif ($cpid == 0) {
27         exec ("$interpreter @ARGV $test 2>$stderr 1>$stdout") || die "Cannot exec: $!";
28 } else {
29         # in the parent, setup the alarm
30         # test must complete in 2 minutes or it is considered buggy
31         my $timeout = 2*60;
32         alarm ($timeout);
33         $SIG{ALRM} = sub {
34                 print "failed after $timeout seconds timeout.\n";
35                 # process group kill
36                 kill (-9, $cpid);
37                 exit (3);
38         };
39         $res = wait ();
40         $SIG{ALRM} = sub {};
41         $res = $? >> 8;
42 }
43
44 if ($res) {
45         printf ("failed $? (%d) signal (%d).\n", $? >> 8, $? & 127);
46         if (($? & 127) == 2) {
47                 exit (2);
48         } else {
49                 exit (1);
50         }
51 }
52 if (-f $output && (read_file ($output) ne read_file ($stdout))) {
53         print "failed output.\n";
54         exit (1);
55 }
56
57 print "pass.\n";
58 unlink ($stderr);
59 exit (0);
60
61 sub read_file {
62         local ($/);
63         my $out = shift;
64         open (F, "<$out") || die $!;
65         $out = <F>;
66         close(F);
67         return $out;
68 }