tor-browser

runtests.pl (7834B)

---

#!/usr/bin/perl
#
# This Source Code Form is subject to the terms of the Mozilla Public
# License, v. 2.0. If a copy of the MPL was not distributed with this
# file, You can obtain one at http://mozilla.org/MPL/2.0/.

use POSIX qw(:sys_wait_h);
use POSIX qw(setsid);
use FileHandle;

# Constants
$WINOS = "MSWin32";

$osname = $^O;

use Cwd;
if ($osname =~ $WINOS) {
   # Windows
   require Win32::Process;
   require Win32;
}

# Get environment variables.
$output_file = $ENV{NSPR_TEST_LOGFILE};
$timeout = $ENV{TEST_TIMEOUT};

$timeout = 0 if (!defined($timeout));

sub getTime {
   ($second, $minute, $hour, $dayOfMonth, $month, $yearOffset, $dayOfWeek, $dayOfYear, $daylightSavings) = localtime();

   $year = 1900 + $yearOffset;

   $theTime = sprintf("%04d-%02d-%02d %02d:%02d:%02d",$year,$month,$dayOfMonth,$hour,$minute,$second);
   return $theTime;
}

sub open_log {

   if (!defined($output_file)) {
       print "No output file.\n";
       # null device
       if ($osname =~ $WINOS) {
           $output_file = "nul";
       } else {
           $output_file = "/dev/null";
       }
   }
   
   # use STDOUT for OF (to print summary of test results)
   open(OF, ">&STDOUT") or die "Can't reuse STDOUT for OF\n";
   OF->autoflush;
   # reassign STDOUT to $output_file (to print details of test results)
   open(STDOUT, ">$output_file") or die "Can't open file $output_file for STDOUT\n";
   STDOUT->autoflush;
   # redirect STDERR to STDOUT
   open(STDERR, ">&STDOUT") or die "Can't redirect STDERR to STDOUT\n";
   STDERR->autoflush;
   
   # Print header test in summary
   $now = getTime;
   print OF "\nNSPR Test Results - tests\n";
   print OF "\nBEGIN\t\t\t$now\n";
   print OF "NSPR_TEST_LOGFILE\t$output_file\n";
   print OF "TEST_TIMEOUT\t$timeout\n\n";
   print OF "\nTest\t\t\tResult\n\n";
}

sub close_log {
   # end of test marker in summary
   $now = getTime;
   print OF "END\t\t\t$now\n";

   close(OF) or die "Can't close file OF\n";
   close(STDERR) or die "Can't close STDERR\n";
   close(STDOUT) or die "Can't close STDOUT\n";
}

sub print_begin {
$lprog = shift;

   # Summary output
   print OF "$prog";
   # Full output
   $now = getTime;
   print "BEGIN TEST: $lprog ($now)\n\n";
}

sub print_end {
($lprog, $exit_status, $exit_signal, $exit_core) = @_;

   if (($exit_status == 0) && ($exit_signal == 0) && ($exit_core == 0)) {
       $str_status = "Passed";
   } else {
       $str_status = "FAILED";
   }
   if ($exit_signal != 0) {
   	$str_signal = " - signal $exit_signal";
   } else {
   	$str_signal = "";
   }
   if ($exit_core != 0) {
   	$str_core = " - core dumped";
   } else {
   	$str_core = "";
   }
   $now = getTime;
   # Full output
   print "\nEND TEST: $lprog ($now)\n";
   print "TEST STATUS: $lprog = $str_status (exit status " . $exit_status . $str_signal . $str_core . ")\n";
   print "--------------------------------------------------\n\n";
   # Summary output
   print OF "\t\t\t$str_status\n";
}

sub ux_start_prog {
# parameters:
$lprog = shift; # command to run

   # Create a process group for the child
   # so we can kill all of it if needed
   setsid or die "setsid failed: $!";
   # Start test program    
   exec("./$lprog");
   # We should not be here unless exec failed.
   print "Faild to exec $lprog";
   exit 1 << 8;
}   

sub ux_wait_timeout {
# parameters:
$lpid = shift;     # child process id
$ltimeout = shift; # timeout

   if ($ltimeout == 0) {
       # No timeout: use blocking wait
       $ret = waitpid($lpid,0);
       # Exit and don't kill
       $lstatus = $?;
       $ltimeout = -1;
   } else {
       while ($ltimeout > 0) {
           # Check status of child using non blocking wait
           $ret = waitpid($lpid, WNOHANG);
           if ($ret == 0) {
               # Child still running
   #           print "Time left=$ltimeout\n";
               sleep 1;
               $ltimeout--;
           } else {
               # Child has ended
               $lstatus = $?;
               # Exit the wait loop and don't kill
               $ltimeout = -1;
           }
       }
   }
   
   if ($ltimeout == 0) {
       # we ran all the timeout: it's time to kill the child
       print "Timeout ! Kill child process $lpid\n";
       # Kill the child process and group
       kill(-9,$lpid);
       $lstatus = 9;
   }
   
   return $lstatus;
}

sub ux_test_prog {
# parameters:
$prog = shift;  # Program to test

   $child_pid = fork;
   if ($child_pid == 0) {
       # we are in the child process
       print_begin($prog);
       ux_start_prog($prog);
   } else {
       # we are in the parent process
       $status = ux_wait_timeout($child_pid,$timeout);
       # See Perlvar for documentation of $?
       # exit status = $status >> 8
       # exit signal = $status & 127 (no signal = 0)
       # core dump = $status & 128 (no core = 0)
       print_end($prog, $status >> 8, $status & 127, $status & 128);
   }

   return $status;
}

sub win_path {
$lpath = shift;

   # MSYS drive letter = /c/ -> c:/
   $lpath =~ s/^\/(\w)\//$1:\//;
   # Cygwin drive letter = /cygdrive/c/ -> c:/
   $lpath =~ s/^\/cygdrive\/(\w)\//$1:\//;
   # replace / with \\
   $lpath =~ s/\//\\\\/g;
   
   return $lpath;
}

sub win_ErrorReport{
   print Win32::FormatMessage( Win32::GetLastError() );
}

sub win_test_prog {
# parameters:
$prog = shift;  # Program to test

   $status = 1;
   $curdir = getcwd;
   $curdir = win_path($curdir);
   $prog_path = "$curdir\\$prog.exe";
   
   print_begin($prog);
   
   Win32::Process::Create($ProcessObj,
                          "$prog_path",
                          "$prog",
                          0,
                          NORMAL_PRIORITY_CLASS,
                          ".")|| die win_ErrorReport();
   $retwait = $ProcessObj->Wait($timeout * 1000);
       
   if ( $retwait == 0) {
       # the prog didn't finish after the timeout: kill
       $ProcessObj->Kill($status);
       print "Timeout ! Process killed with exit status $status\n";
   } else {
       # the prog finished before the timeout: get exit status
       $ProcessObj->GetExitCode($status);
   }
   # There is no signal, no core on Windows
   print_end($prog, $status, 0, 0);

   return $status
}

# MAIN ---------------
@progs = (
"abstract",
"accept",
"acceptread",
"acceptreademu",
"affinity",
"alarm",
"anonfm",
"atomic",
"attach",
"bigfile",
"cleanup",
"cltsrv",
"concur",
"cvar",
"cvar2",
"dlltest",
"dtoa",
"errcodes",
"exit",
"fdcach",
"fileio",
"foreign",
"formattm",
"fsync",
"gethost",
"getproto",
"i2l",
"initclk",
"inrval",
"instrumt",
"intrio",
"intrupt",
"io_timeout",
"ioconthr",
"join",
"joinkk",
"joinku",
"joinuk",
"joinuu",
"layer",
"lazyinit",
"libfilename",
"lltest",
"lock",
"lockfile",
"logfile",
"logger",
"many_cv",
"nameshm1",
"nblayer",
"nonblock",
"ntioto",
"ntoh",
"op_2long",
"op_excl",
"op_filnf",
"op_filok",
"op_nofil",
"parent",
"parsetm",
"peek",
"perf",
"pipeping",
"pipeping2",
"pipeself",
"poll_nm",
"poll_to",
"pollable",
"prftest",
"prfz",
"primblok",
"provider",
"prpollml",
"pushtop",
"ranfile",
"randseed",
"reinit",
"rwlocktest",
"sel_spd",
"selct_er",
"selct_nm",
"selct_to",
"selintr",
"sema",
"semaerr",
"semaping",
"sendzlf",
"server_test",
"servr_kk",
"servr_uk",
"servr_ku",
"servr_uu",
"short_thread",
"sigpipe",
"socket",
"sockopt",
"sockping",
"sprintf",
"stack",
"stdio",
"str2addr",
"strod",
"switch",
"system",
"testbit",
"testfile",
"threads",
"timemac",
"timetest",
"tpd",
"udpsrv",
"vercheck",
"version",
"writev",
"xnotify",
"zerolen");

open_log;

foreach $current_prog (@progs) {
   if ($osname =~ $WINOS) {
       win_test_prog($current_prog);
   } else {
       ux_test_prog($current_prog);
   }
}

close_log;