michael@0: #!/usr/bin/perl
michael@0: #
michael@0: # This Source Code Form is subject to the terms of the Mozilla Public
michael@0: # License, v. 2.0. If a copy of the MPL was not distributed with this
michael@0: # file, You can obtain one at http://mozilla.org/MPL/2.0/.
michael@0: 
michael@0: use POSIX qw(:sys_wait_h);
michael@0: use POSIX qw(setsid);
michael@0: use FileHandle;
michael@0: 
michael@0: # Constants
michael@0: $WINOS = "MSWin32";
michael@0: 
michael@0: $osname = $^O;
michael@0: 
michael@0: use Cwd;
michael@0: if ($osname =~ $WINOS) {
michael@0:     # Windows
michael@0:     require Win32::Process;
michael@0:     require Win32;
michael@0: }
michael@0: 
michael@0: # Get environment variables.
michael@0: $output_file = $ENV{NSPR_TEST_LOGFILE};
michael@0: $timeout = $ENV{TEST_TIMEOUT};
michael@0: 
michael@0: $timeout = 0 if (!defined($timeout));
michael@0: 
michael@0: sub getTime {
michael@0:     ($second, $minute, $hour, $dayOfMonth, $month, $yearOffset, $dayOfWeek, $dayOfYear, $daylightSavings) = localtime();
michael@0: 
michael@0:     $year = 1900 + $yearOffset;
michael@0: 
michael@0:     $theTime = sprintf("%04d-%02d-%02d %02d:%02d:%02d",$year,$month,$dayOfMonth,$hour,$minute,$second);
michael@0:     return $theTime;
michael@0: }
michael@0: 
michael@0: sub open_log {
michael@0: 
michael@0:     if (!defined($output_file)) {
michael@0:         print "No output file.\n";
michael@0:         # null device
michael@0:         if ($osname =~ $WINOS) {
michael@0:             $output_file = "nul";
michael@0:         } else {
michael@0:             $output_file = "/dev/null";
michael@0:         }
michael@0:     }
michael@0:     
michael@0:     # use STDOUT for OF (to print summary of test results)
michael@0:     open(OF, ">&STDOUT") or die "Can't reuse STDOUT for OF\n";
michael@0:     OF->autoflush;
michael@0:     # reassign STDOUT to $output_file (to print details of test results)
michael@0:     open(STDOUT, ">$output_file") or die "Can't open file $output_file for STDOUT\n";
michael@0:     STDOUT->autoflush;
michael@0:     # redirect STDERR to STDOUT
michael@0:     open(STDERR, ">&STDOUT") or die "Can't redirect STDERR to STDOUT\n";
michael@0:     STDERR->autoflush;
michael@0:     
michael@0:     # Print header test in summary
michael@0:     $now = getTime;
michael@0:     print OF "\nNSPR Test Results - tests\n";
michael@0:     print OF "\nBEGIN\t\t\t$now\n";
michael@0:     print OF "NSPR_TEST_LOGFILE\t$output_file\n";
michael@0:     print OF "TEST_TIMEOUT\t$timeout\n\n";
michael@0:     print OF "\nTest\t\t\tResult\n\n";
michael@0: }
michael@0: 
michael@0: sub close_log {
michael@0:     # end of test marker in summary
michael@0:     $now = getTime;
michael@0:     print OF "END\t\t\t$now\n";
michael@0: 
michael@0:     close(OF) or die "Can't close file OF\n";
michael@0:     close(STDERR) or die "Can't close STDERR\n";
michael@0:     close(STDOUT) or die "Can't close STDOUT\n";
michael@0: }
michael@0: 
michael@0: sub print_begin {
michael@0: $lprog = shift;
michael@0: 
michael@0:     # Summary output
michael@0:     print OF "$prog";
michael@0:     # Full output
michael@0:     $now = getTime;
michael@0:     print "BEGIN TEST: $lprog ($now)\n\n";
michael@0: }
michael@0: 
michael@0: sub print_end {
michael@0: ($lprog, $exit_status, $exit_signal, $exit_core) = @_;
michael@0: 
michael@0:     if (($exit_status == 0) && ($exit_signal == 0) && ($exit_core == 0)) {
michael@0:         $str_status = "Passed";
michael@0:     } else {
michael@0:         $str_status = "FAILED";
michael@0:     }
michael@0:     if ($exit_signal != 0) {
michael@0:     	$str_signal = " - signal $exit_signal";
michael@0:     } else {
michael@0:     	$str_signal = "";
michael@0:     }
michael@0:     if ($exit_core != 0) {
michael@0:     	$str_core = " - core dumped";
michael@0:     } else {
michael@0:     	$str_core = "";
michael@0:     }
michael@0:     $now = getTime;
michael@0:     # Full output
michael@0:     print "\nEND TEST: $lprog ($now)\n";
michael@0:     print "TEST STATUS: $lprog = $str_status (exit status " . $exit_status . $str_signal . $str_core . ")\n";
michael@0:     print "--------------------------------------------------\n\n";
michael@0:     # Summary output
michael@0:     print OF "\t\t\t$str_status\n";
michael@0: }
michael@0: 
michael@0: sub ux_start_prog {
michael@0: # parameters:
michael@0: $lprog = shift; # command to run
michael@0: 
michael@0:     # Create a process group for the child
michael@0:     # so we can kill all of it if needed
michael@0:     setsid or die "setsid failed: $!";
michael@0:     # Start test program    
michael@0:     exec("./$lprog");
michael@0:     # We should not be here unless exec failed.
michael@0:     print "Faild to exec $lprog";
michael@0:     exit 1 << 8;
michael@0: }   
michael@0: 
michael@0: sub ux_wait_timeout {
michael@0: # parameters:
michael@0: $lpid = shift;     # child process id
michael@0: $ltimeout = shift; # timeout
michael@0: 
michael@0:     if ($ltimeout == 0) {
michael@0:         # No timeout: use blocking wait
michael@0:         $ret = waitpid($lpid,0);
michael@0:         # Exit and don't kill
michael@0:         $lstatus = $?;
michael@0:         $ltimeout = -1;
michael@0:     } else {
michael@0:         while ($ltimeout > 0) {
michael@0:             # Check status of child using non blocking wait
michael@0:             $ret = waitpid($lpid, WNOHANG);
michael@0:             if ($ret == 0) {
michael@0:                 # Child still running
michael@0:     #           print "Time left=$ltimeout\n";
michael@0:                 sleep 1;
michael@0:                 $ltimeout--;
michael@0:             } else {
michael@0:                 # Child has ended
michael@0:                 $lstatus = $?;
michael@0:                 # Exit the wait loop and don't kill
michael@0:                 $ltimeout = -1;
michael@0:             }
michael@0:         }
michael@0:     }
michael@0:     
michael@0:     if ($ltimeout == 0) {
michael@0:         # we ran all the timeout: it's time to kill the child
michael@0:         print "Timeout ! Kill child process $lpid\n";
michael@0:         # Kill the child process and group
michael@0:         kill(-9,$lpid);
michael@0:         $lstatus = 9;
michael@0:     }
michael@0:     
michael@0:     return $lstatus;
michael@0: }
michael@0: 
michael@0: sub ux_test_prog {
michael@0: # parameters:
michael@0: $prog = shift;  # Program to test
michael@0: 
michael@0:     $child_pid = fork;
michael@0:     if ($child_pid == 0) {
michael@0:         # we are in the child process
michael@0:         print_begin($prog);
michael@0:         ux_start_prog($prog);
michael@0:     } else {
michael@0:         # we are in the parent process
michael@0:         $status = ux_wait_timeout($child_pid,$timeout);
michael@0:         # See Perlvar for documentation of $?
michael@0:         # exit status = $status >> 8
michael@0:         # exit signal = $status & 127 (no signal = 0)
michael@0:         # core dump = $status & 128 (no core = 0)
michael@0:         print_end($prog, $status >> 8, $status & 127, $status & 128);
michael@0:     }
michael@0: 
michael@0:     return $status;
michael@0: }
michael@0: 
michael@0: sub win_path {
michael@0: $lpath = shift;
michael@0: 
michael@0:     # MSYS drive letter = /c/ -> c:/
michael@0:     $lpath =~ s/^\/(\w)\//$1:\//;
michael@0:     # Cygwin drive letter = /cygdrive/c/ -> c:/
michael@0:     $lpath =~ s/^\/cygdrive\/(\w)\//$1:\//;
michael@0:     # replace / with \\
michael@0:     $lpath =~ s/\//\\\\/g;
michael@0:     
michael@0:     return $lpath;
michael@0: }
michael@0: 
michael@0: sub win_ErrorReport{
michael@0:     print Win32::FormatMessage( Win32::GetLastError() );
michael@0: }
michael@0: 
michael@0: sub win_test_prog {
michael@0: # parameters:
michael@0: $prog = shift;  # Program to test
michael@0: 
michael@0:     $status = 1;
michael@0:     $curdir = getcwd;
michael@0:     $curdir = win_path($curdir);
michael@0:     $prog_path = "$curdir\\$prog.exe";
michael@0:     
michael@0:     print_begin($prog);
michael@0:     
michael@0:     Win32::Process::Create($ProcessObj,
michael@0:                            "$prog_path",
michael@0:                            "$prog",
michael@0:                            0,
michael@0:                            NORMAL_PRIORITY_CLASS,
michael@0:                            ".")|| die win_ErrorReport();
michael@0:     $retwait = $ProcessObj->Wait($timeout * 1000);
michael@0:         
michael@0:     if ( $retwait == 0) {
michael@0:         # the prog didn't finish after the timeout: kill
michael@0:         $ProcessObj->Kill($status);
michael@0:         print "Timeout ! Process killed with exit status $status\n";
michael@0:     } else {
michael@0:         # the prog finished before the timeout: get exit status
michael@0:         $ProcessObj->GetExitCode($status);
michael@0:     }
michael@0:     # There is no signal, no core on Windows
michael@0:     print_end($prog, $status, 0, 0);
michael@0: 
michael@0:     return $status
michael@0: }
michael@0: 
michael@0: # MAIN ---------------
michael@0: @progs = (
michael@0: "accept",
michael@0: "acceptread",
michael@0: "acceptreademu",
michael@0: "affinity",
michael@0: "alarm",
michael@0: "anonfm",
michael@0: "atomic",
michael@0: "attach",
michael@0: "bigfile",
michael@0: "cleanup",
michael@0: "cltsrv",
michael@0: "concur",
michael@0: "cvar",
michael@0: "cvar2",
michael@0: "dlltest",
michael@0: "dtoa",
michael@0: "errcodes",
michael@0: "exit",
michael@0: "fdcach",
michael@0: "fileio",
michael@0: "foreign",
michael@0: "formattm",
michael@0: "fsync",
michael@0: "gethost",
michael@0: "getproto",
michael@0: "i2l",
michael@0: "initclk",
michael@0: "inrval",
michael@0: "instrumt",
michael@0: "intrio",
michael@0: "intrupt",
michael@0: "io_timeout",
michael@0: "ioconthr",
michael@0: "join",
michael@0: "joinkk",
michael@0: "joinku",
michael@0: "joinuk",
michael@0: "joinuu",
michael@0: "layer",
michael@0: "lazyinit",
michael@0: "libfilename",
michael@0: "lltest",
michael@0: "lock",
michael@0: "lockfile",
michael@0: "logfile",
michael@0: "logger",
michael@0: "many_cv",
michael@0: "multiwait",
michael@0: "nameshm1",
michael@0: "nblayer",
michael@0: "nonblock",
michael@0: "ntioto",
michael@0: "ntoh",
michael@0: "op_2long",
michael@0: "op_excl",
michael@0: "op_filnf",
michael@0: "op_filok",
michael@0: "op_nofil",
michael@0: "parent",
michael@0: "parsetm",
michael@0: "peek",
michael@0: "perf",
michael@0: "pipeping",
michael@0: "pipeping2",
michael@0: "pipeself",
michael@0: "poll_nm",
michael@0: "poll_to",
michael@0: "pollable",
michael@0: "prftest",
michael@0: "primblok",
michael@0: "provider",
michael@0: "prpollml",
michael@0: "pushtop",
michael@0: "ranfile",
michael@0: "randseed",
michael@0: "reinit",
michael@0: "rwlocktest",
michael@0: "sel_spd",
michael@0: "selct_er",
michael@0: "selct_nm",
michael@0: "selct_to",
michael@0: "selintr",
michael@0: "sema",
michael@0: "semaerr",
michael@0: "semaping",
michael@0: "sendzlf",
michael@0: "server_test",
michael@0: "servr_kk",
michael@0: "servr_uk",
michael@0: "servr_ku",
michael@0: "servr_uu",
michael@0: "short_thread",
michael@0: "sigpipe",
michael@0: "socket",
michael@0: "sockopt",
michael@0: "sockping",
michael@0: "sprintf",
michael@0: "stack",
michael@0: "stdio",
michael@0: "str2addr",
michael@0: "strod",
michael@0: "switch",
michael@0: "system",
michael@0: "testbit",
michael@0: "testfile",
michael@0: "threads",
michael@0: "timemac",
michael@0: "timetest",
michael@0: "tpd",
michael@0: "udpsrv",
michael@0: "vercheck",
michael@0: "version",
michael@0: "writev",
michael@0: "xnotify",
michael@0: "zerolen");
michael@0: 
michael@0: open_log;
michael@0: 
michael@0: foreach $current_prog (@progs) {
michael@0:     if ($osname =~ $WINOS) {
michael@0:         win_test_prog($current_prog);
michael@0:     } else {
michael@0:         ux_test_prog($current_prog);
michael@0:     }
michael@0: }
michael@0: 
michael@0: close_log;