nsprpub/pr/tests/runtests.pl

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