1#!/usr/bin/perl 2# 3# This Source Code Form is subject to the terms of the Mozilla Public 4# License, v. 2.0. If a copy of the MPL was not distributed with this 5# file, You can obtain one at http://mozilla.org/MPL/2.0/. 6 7use POSIX qw(:sys_wait_h); 8use POSIX qw(setsid); 9use FileHandle; 10 11# Constants 12$WINOS = "MSWin32"; 13 14$osname = $^O; 15 16use Cwd; 17if ($osname =~ $WINOS) { 18 # Windows 19 require Win32::Process; 20 require Win32; 21} 22 23# Get environment variables. 24$output_file = $ENV{NSPR_TEST_LOGFILE}; 25$timeout = $ENV{TEST_TIMEOUT}; 26 27$timeout = 0 if (!defined($timeout)); 28 29sub getTime { 30 ($second, $minute, $hour, $dayOfMonth, $month, $yearOffset, $dayOfWeek, $dayOfYear, $daylightSavings) = localtime(); 31 32 $year = 1900 + $yearOffset; 33 34 $theTime = sprintf("%04d-%02d-%02d %02d:%02d:%02d",$year,$month,$dayOfMonth,$hour,$minute,$second); 35 return $theTime; 36} 37 38sub open_log { 39 40 if (!defined($output_file)) { 41 print "No output file.\n"; 42 # null device 43 if ($osname =~ $WINOS) { 44 $output_file = "nul"; 45 } else { 46 $output_file = "/dev/null"; 47 } 48 } 49 50 # use STDOUT for OF (to print summary of test results) 51 open(OF, ">&STDOUT") or die "Can't reuse STDOUT for OF\n"; 52 OF->autoflush; 53 # reassign STDOUT to $output_file (to print details of test results) 54 open(STDOUT, ">$output_file") or die "Can't open file $output_file for STDOUT\n"; 55 STDOUT->autoflush; 56 # redirect STDERR to STDOUT 57 open(STDERR, ">&STDOUT") or die "Can't redirect STDERR to STDOUT\n"; 58 STDERR->autoflush; 59 60 # Print header test in summary 61 $now = getTime; 62 print OF "\nNSPR Test Results - tests\n"; 63 print OF "\nBEGIN\t\t\t$now\n"; 64 print OF "NSPR_TEST_LOGFILE\t$output_file\n"; 65 print OF "TEST_TIMEOUT\t$timeout\n\n"; 66 print OF "\nTest\t\t\tResult\n\n"; 67} 68 69sub close_log { 70 # end of test marker in summary 71 $now = getTime; 72 print OF "END\t\t\t$now\n"; 73 74 close(OF) or die "Can't close file OF\n"; 75 close(STDERR) or die "Can't close STDERR\n"; 76 close(STDOUT) or die "Can't close STDOUT\n"; 77} 78 79sub print_begin { 80$lprog = shift; 81 82 # Summary output 83 print OF "$prog"; 84 # Full output 85 $now = getTime; 86 print "BEGIN TEST: $lprog ($now)\n\n"; 87} 88 89sub print_end { 90($lprog, $exit_status, $exit_signal, $exit_core) = @_; 91 92 if (($exit_status == 0) && ($exit_signal == 0) && ($exit_core == 0)) { 93 $str_status = "Passed"; 94 } else { 95 $str_status = "FAILED"; 96 } 97 if ($exit_signal != 0) { 98 $str_signal = " - signal $exit_signal"; 99 } else { 100 $str_signal = ""; 101 } 102 if ($exit_core != 0) { 103 $str_core = " - core dumped"; 104 } else { 105 $str_core = ""; 106 } 107 $now = getTime; 108 # Full output 109 print "\nEND TEST: $lprog ($now)\n"; 110 print "TEST STATUS: $lprog = $str_status (exit status " . $exit_status . $str_signal . $str_core . ")\n"; 111 print "--------------------------------------------------\n\n"; 112 # Summary output 113 print OF "\t\t\t$str_status\n"; 114} 115 116sub ux_start_prog { 117# parameters: 118$lprog = shift; # command to run 119 120 # Create a process group for the child 121 # so we can kill all of it if needed 122 setsid or die "setsid failed: $!"; 123 # Start test program 124 exec("./$lprog"); 125 # We should not be here unless exec failed. 126 print "Faild to exec $lprog"; 127 exit 1 << 8; 128} 129 130sub ux_wait_timeout { 131# parameters: 132$lpid = shift; # child process id 133$ltimeout = shift; # timeout 134 135 if ($ltimeout == 0) { 136 # No timeout: use blocking wait 137 $ret = waitpid($lpid,0); 138 # Exit and don't kill 139 $lstatus = $?; 140 $ltimeout = -1; 141 } else { 142 while ($ltimeout > 0) { 143 # Check status of child using non blocking wait 144 $ret = waitpid($lpid, WNOHANG); 145 if ($ret == 0) { 146 # Child still running 147 # print "Time left=$ltimeout\n"; 148 sleep 1; 149 $ltimeout--; 150 } else { 151 # Child has ended 152 $lstatus = $?; 153 # Exit the wait loop and don't kill 154 $ltimeout = -1; 155 } 156 } 157 } 158 159 if ($ltimeout == 0) { 160 # we ran all the timeout: it's time to kill the child 161 print "Timeout ! Kill child process $lpid\n"; 162 # Kill the child process and group 163 kill(-9,$lpid); 164 $lstatus = 9; 165 } 166 167 return $lstatus; 168} 169 170sub ux_test_prog { 171# parameters: 172$prog = shift; # Program to test 173 174 $child_pid = fork; 175 if ($child_pid == 0) { 176 # we are in the child process 177 print_begin($prog); 178 ux_start_prog($prog); 179 } else { 180 # we are in the parent process 181 $status = ux_wait_timeout($child_pid,$timeout); 182 # See Perlvar for documentation of $? 183 # exit status = $status >> 8 184 # exit signal = $status & 127 (no signal = 0) 185 # core dump = $status & 128 (no core = 0) 186 print_end($prog, $status >> 8, $status & 127, $status & 128); 187 } 188 189 return $status; 190} 191 192sub win_path { 193$lpath = shift; 194 195 # MSYS drive letter = /c/ -> c:/ 196 $lpath =~ s/^\/(\w)\//$1:\//; 197 # Cygwin drive letter = /cygdrive/c/ -> c:/ 198 $lpath =~ s/^\/cygdrive\/(\w)\//$1:\//; 199 # replace / with \\ 200 $lpath =~ s/\//\\\\/g; 201 202 return $lpath; 203} 204 205sub win_ErrorReport{ 206 print Win32::FormatMessage( Win32::GetLastError() ); 207} 208 209sub win_test_prog { 210# parameters: 211$prog = shift; # Program to test 212 213 $status = 1; 214 $curdir = getcwd; 215 $curdir = win_path($curdir); 216 $prog_path = "$curdir\\$prog.exe"; 217 218 print_begin($prog); 219 220 Win32::Process::Create($ProcessObj, 221 "$prog_path", 222 "$prog", 223 0, 224 NORMAL_PRIORITY_CLASS, 225 ".")|| die win_ErrorReport(); 226 $retwait = $ProcessObj->Wait($timeout * 1000); 227 228 if ( $retwait == 0) { 229 # the prog didn't finish after the timeout: kill 230 $ProcessObj->Kill($status); 231 print "Timeout ! Process killed with exit status $status\n"; 232 } else { 233 # the prog finished before the timeout: get exit status 234 $ProcessObj->GetExitCode($status); 235 } 236 # There is no signal, no core on Windows 237 print_end($prog, $status, 0, 0); 238 239 return $status 240} 241 242# MAIN --------------- 243@progs = ( 244"abstract", 245"accept", 246"acceptread", 247"acceptreademu", 248"affinity", 249"alarm", 250"anonfm", 251"atomic", 252"attach", 253"bigfile", 254"cleanup", 255"cltsrv", 256"concur", 257"cvar", 258"cvar2", 259"dlltest", 260"dtoa", 261"errcodes", 262"exit", 263"fdcach", 264"fileio", 265"foreign", 266"formattm", 267"fsync", 268"gethost", 269"getproto", 270"i2l", 271"initclk", 272"inrval", 273"instrumt", 274"intrio", 275"intrupt", 276"io_timeout", 277"ioconthr", 278"join", 279"joinkk", 280"joinku", 281"joinuk", 282"joinuu", 283"layer", 284"lazyinit", 285"libfilename", 286"lltest", 287"lock", 288"lockfile", 289"logfile", 290"logger", 291"many_cv", 292"nameshm1", 293"nblayer", 294"nonblock", 295"ntioto", 296"ntoh", 297"op_2long", 298"op_excl", 299"op_filnf", 300"op_filok", 301"op_nofil", 302"parent", 303"parsetm", 304"peek", 305"perf", 306"pipeping", 307"pipeping2", 308"pipeself", 309"poll_nm", 310"poll_to", 311"pollable", 312"prftest", 313"prfz", 314"primblok", 315"provider", 316"prpollml", 317"pushtop", 318"ranfile", 319"randseed", 320"reinit", 321"rwlocktest", 322"sel_spd", 323"selct_er", 324"selct_nm", 325"selct_to", 326"selintr", 327"sema", 328"semaerr", 329"semaping", 330"sendzlf", 331"server_test", 332"servr_kk", 333"servr_uk", 334"servr_ku", 335"servr_uu", 336"short_thread", 337"sigpipe", 338"socket", 339"sockopt", 340"sockping", 341"sprintf", 342"stack", 343"stdio", 344"str2addr", 345"strod", 346"switch", 347"system", 348"testbit", 349"testfile", 350"threads", 351"timemac", 352"timetest", 353"tpd", 354"udpsrv", 355"vercheck", 356"version", 357"writev", 358"xnotify", 359"zerolen"); 360 361open_log; 362 363foreach $current_prog (@progs) { 364 if ($osname =~ $WINOS) { 365 win_test_prog($current_prog); 366 } else { 367 ux_test_prog($current_prog); 368 } 369} 370 371close_log; 372