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 $dump_output = shift;
   7
   8 my $output = $test;
   9 my $stdout = $test.'.stdout';
  10 my $stderr = $test.'.stderr';
  11
  12 $output =~ s/\.exe$/.output/;
  13
  14 my $timeout_in_minutes = 2;
  15
  16 my $test_binary = $test;
  17
  18 if ($test =~ /.*\|.*/) {
  19         my @values = split(/\|/, $test);
  20         my $binary = @values[0];
  21         my $test_name = @values[1];
  22
  23         $test_binary = $binary;
  24         $test = $test_name . "_" . $binary;
  25         $stdout = $test.'.stdout';
  26         $stderr = $test.'.stderr';
  27         $output = $test;
  28
  29         #This is a silly workaround, but all tests that use extra parameters need a larger timeout.
  30         $timeout_in_minutes = 5;
  31 }
  32
  33 $| = 0;
  34 print "Testing $test... ";
  35
  36 foreach $disabled (split (/ /, $disabled_tests)) {
  37         $disabled =~ s/^\s+|\s+$//g;
  38         if ($disabled eq $test) {
  39                 print "disabled.\n";
  40                 exit (0);
  41         }
  42 }
  43
  44 my $res;
  45 my $cpid = fork ();
  46 if (!defined ($cpid)) {
  47         $res = system("$interpreter @ARGV $test_binary 2>$stderr 1>$stdout");
  48 } elsif ($cpid == 0) {
  49         exec ("$interpreter @ARGV $test_binary 2>$stderr 1>$stdout") || die "Cannot exec: $!";
  50 } else {
  51         # in the parent, setup the alarm
  52         # test must complete in 2 minutes or it is considered buggy
  53         my $timeout = $timeout_in_minutes * 60;
  54         alarm ($timeout);
  55         $SIG{ALRM} = sub {
  56                 print "failed after $timeout seconds timeout.\n";
  57                 dump_files ();
  58                 # process group kill
  59                 kill (-9, $cpid);
  60                 exit (3);
  61         };
  62         $res = wait ();
  63         $SIG{ALRM} = sub {};
  64         $res = $? >> 8;
  65 }
  66
  67 if ($res) {
  68         printf ("failed $? (%d) signal (%d).\n", $? >> 8, $? & 127);
  69         dump_files ();
  70         if (($? & 127) == 2) {
  71                 exit (2);
  72         } else {
  73                 exit (1);
  74         }
  75 }
  76 if (-f $output && (read_file ($output) ne read_file ($stdout))) {
  77         print "failed output.\n";
  78         dump_files ();
  79         exit (1);
  80 }
  81
  82 print "pass.\n";
  83 unlink ($stderr);
  84 exit (0);
  85
  86 sub dump_files {
  87         if ($dump_output ne "dump-output") {
  88                 return;
  89         }
  90
  91         printf ("----STDOUT-----\n");
  92         print read_file($stdout);
  93         printf ("----STDERR-----\n");
  94         print read_file($stderr);
  95         printf ("---------------\n");
  96 }
  97
  98 sub read_file {
  99         local ($/);
 100         my $out = shift;
 101         open (F, "<$out") || die $!;
 102         $out = <F>;
 103         close(F);
 104         return $out;
 105 }