js/tests/jsDriver.pl

   1 #!/usr/bin/perl
   2 # -*- Mode: Perl; tab-width: 4; indent-tabs-mode: nil; -*-
   3 # vim: set ts=4 sw=4 et tw=80:
   4 # ***** BEGIN LICENSE BLOCK *****
   5 # Version: MPL 1.1/GPL 2.0/LGPL 2.1
   6 #
   7 # The contents of this file are subject to the Mozilla Public License Version
   8 # 1.1 (the "License"); you may not use this file except in compliance with
   9 # the License. You may obtain a copy of the License at
  10 # http://www.mozilla.org/MPL/
  11 #
  12 # Software distributed under the License is distributed on an "AS IS" basis,
  13 # WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
  14 # for the specific language governing rights and limitations under the
  15 # License.
  16 #
  17 # The Original Code is JavaScript Core Tests.
  18 #
  19 # The Initial Developer of the Original Code is
  20 # Netscape Communications Corporation.
  21 # Portions created by the Initial Developer are Copyright (C) 1997-1999
  22 # the Initial Developer. All Rights Reserved.
  23 #
  24 # Contributor(s):
  25 #   Robert Ginda <rginda@netscape.com>
  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 # Second cut at runtests.pl script originally by
  42 # Christine Begle (cbegle@netscape.com)
  43 # Branched 11/01/99
  44
  45 use strict;
  46 use Getopt::Mixed "nextOption";
  47 use File::Temp qw/ tempfile tempdir /;
  48 use POSIX qw(sys_wait_h);
  49
  50 my $os_type = &get_os_type;
  51 my $unixish = (($os_type ne "WIN") && ($os_type ne "MAC"));
  52 my $path_sep = ($os_type eq "MAC") ? ":" : "/";
  53 my $win_sep  = ($os_type eq "WIN")? &get_win_sep : "";
  54 my $redirect_command = ($os_type ne "MAC") ? " 2>&1" : "";
  55
  56 # command line option defaults
  57 my $opt_suite_path;
  58 my $opt_trace = 0;
  59 my $opt_classpath = "";
  60 my $opt_rhino_opt = 0;
  61 my $opt_rhino_ms = 0;
  62 my @opt_engine_list;
  63 my $opt_engine_type = "";
  64 my $opt_engine_params = "";
  65 my $opt_user_output_file = 0;
  66 my $opt_output_file = "";
  67 my @opt_test_list_files;
  68 my @opt_neg_list_files;
  69 my $opt_shell_path = "";
  70 my $opt_java_path = "";
  71 my $opt_bug_url = "https://bugzilla.mozilla.org/show_bug.cgi?id=";
  72 my $opt_console_failures = 0;
  73 my $opt_console_failures_line = 0;
  74 my $opt_lxr_url = "http://lxr.mozilla.org/mozilla/source/js/tests/";
  75 my $opt_exit_munge = ($os_type ne "MAC") ? 1 : 0;
  76 my $opt_timeout = 3600;
  77 my $opt_enable_narcissus = 0;
  78 my $opt_narcissus_path = "";
  79 my $opt_no_quit = 0;
  80 my $opt_report_summarized_results = 0;
  81
  82 # command line option definition
  83 my $options = "b=s bugurl>b c=s classpath>c e=s engine>e f=s file>f " .
  84   "h help>h i j=s javapath>j k confail>k K linefail>K R report>R l=s list>l " .
  85   "L=s neglist>L o=s opt>o p=s testpath>p s=s shellpath>s t trace>t " .
  86   "T=s timeout>T u=s lxrurl>u " .
  87   "x noexitmunge>x n:s narcissus>n " .
  88   "Q noquitinthandler>Q";
  89
  90 if ($os_type eq "MAC") {
  91     $opt_suite_path = `directory`;
  92     $opt_suite_path =~ s/[\n\r]//g;
  93     $opt_suite_path .= ":";
  94 } else {
  95     $opt_suite_path = "./";
  96 }
  97
  98 &parse_args;
  99
 100 my $user_exit = 0;
 101 my ($engine_command, $html, $failures_reported, $tests_completed,
 102     $exec_time_string);
 103 my @failed_tests;
 104 my @test_list = &get_test_list;
 105
 106 if ($#test_list == -1) {
 107     die ("Nothing to test.\n");
 108 }
 109
 110 if ($unixish && $opt_no_quit == 0) {
 111     # on unix, ^C pauses the tests, and gives the user a chance to quit but
 112     # report on what has been done, to just quit, or to continue (the
 113     # interrupted test will still be skipped.)
 114     # windows doesn't handle the int handler they way we want it to,
 115     # so don't even pretend to let the user continue.
 116     $SIG{INT} = 'int_handler';
 117 }
 118
 119 my $current_test;
 120 my $current_test_pid;
 121
 122 &main;
 123
 124 #End.
 125
 126 sub main {
 127     my $start_time;
 128
 129     while ($opt_engine_type = pop (@opt_engine_list)) {
 130         dd ("Testing engine '$opt_engine_type'");
 131
 132         $engine_command = &get_engine_command;
 133         $html = "";
 134         @failed_tests = ();
 135         $failures_reported = 0;
 136         $tests_completed = 0;
 137         $start_time = time;
 138
 139
 140         &execute_tests (@test_list);
 141
 142         my $exec_time = (time - $start_time);
 143         my $exec_hours = int($exec_time / 60 / 60);
 144         $exec_time -= $exec_hours * 60 * 60;
 145         my $exec_mins = int($exec_time / 60);
 146         $exec_time -= $exec_mins * 60;
 147         my $exec_secs = ($exec_time % 60);
 148
 149         if ($exec_hours > 0) {
 150             $exec_time_string = "$exec_hours hours, $exec_mins minutes, " .
 151               "$exec_secs seconds";
 152         } elsif ($exec_mins > 0) {
 153             $exec_time_string = "$exec_mins minutes, $exec_secs seconds";
 154         } else {
 155             $exec_time_string = "$exec_secs seconds";
 156         }
 157
 158         if (!$opt_user_output_file) {
 159             $opt_output_file = &get_tempfile_name;
 160         }
 161
 162         &write_results;
 163
 164     }
 165 }
 166
 167 sub append_file_to_command {
 168     my ($command, $file) = @_;
 169
 170     if ($opt_enable_narcissus == 1) {
 171         $command .= " -e 'evaluate(\"load(\\\"$file\\\")\")'"
 172     } else {
 173         $command .= " -f $file";
 174     }
 175 }
 176
 177 sub execute_tests {
 178     my (@test_list) = @_;
 179     my ($test, $shell_command, $line, @output, $path);
 180     my ($last_suite, $last_test_dir);
 181
 182     &status ("Executing " . ($#test_list + 1) . " test(s).");
 183
 184     foreach $test (@test_list) {
 185         my ($suite, $test_dir, $test_file) = split($path_sep, $test);
 186         # *-n.js is a negative test, expect exit code 3 (runtime error)
 187         my $expected_exit = ($test =~ /\-n\.js$/) ? 3 : 0;
 188         my ($got_exit, $exit_signal);
 189         my $failure_lines;
 190         my $bug_number;
 191         my $status_lines;
 192         my $result_lines;
 193
 194         # Allow the test to declare multiple possible success exit codes.
 195         # This is useful in situations where the test fails if a
 196         # crash occurs but passes if no crash occurs even if an
 197         # out of memory error occurs.
 198         my @expected_exit_list = ($expected_exit);
 199
 200         # user selected [Q]uit from ^C handler.
 201         if ($user_exit) {
 202             return;
 203         }
 204
 205         $current_test = $test;
 206
 207         # Append the shell.js files to the shell_command if they're there.
 208         # (only check for their existance if the suite or test_dir has changed
 209         # since the last time we looked.)
 210         if ($last_suite ne $suite || $last_test_dir ne $test_dir) {
 211             $shell_command = &xp_path($engine_command);
 212
 213             $path = &xp_path($opt_suite_path ."shell.js");
 214             if (-f $path) {
 215                 $shell_command = &append_file_to_command($shell_command,
 216                                                          $path);
 217             }
 218
 219             $path = &xp_path($opt_suite_path . $suite . "/shell.js");
 220             if (-f $path) {
 221                 $shell_command = &append_file_to_command($shell_command,
 222                                                          $path);
 223             }
 224
 225             $path = &xp_path($opt_suite_path . $suite . "/" .
 226                              $test_dir . "/shell.js");
 227             if (-f $path) {
 228                 $shell_command = &append_file_to_command($shell_command,
 229                                                          $path);
 230             }
 231
 232             $last_suite = $suite;
 233             $last_test_dir = $test_dir;
 234         }
 235
 236         $path = &xp_path($opt_suite_path . $test);
 237         my $command = &append_file_to_command($shell_command, $path);
 238
 239         $path = &xp_path($opt_suite_path ."js-test-driver-end.js");
 240         if (-f $path) {
 241             $command = &append_file_to_command($command,
 242                                                $path);
 243         }
 244
 245         &dd ("executing: " . $command);
 246
 247         my $jsout;
 248         (undef, $jsout) = tempfile();
 249
 250         #XXX cloned from tinderbox. See sub kill_process
 251         my $pid = fork; # Fork a child process to run the test
 252         unless ($pid) {
 253             open STDOUT, ">$jsout";
 254             open STDERR, ">&STDOUT";
 255             select STDOUT; $| = 1; # make STDOUT unbuffered
 256             select STDERR; $| = 1; # make STDERR unbuffered
 257             exec $command;
 258             die "Could not exec $command";
 259         }
 260
 261         $current_test_pid = $pid;
 262
 263         my $timed_out = 0;
 264         my $dumped_core = 0;
 265         my $loop_count = 0;
 266         my $wait_pid = -1;
 267
 268         eval
 269         {
 270             local $SIG{ALRM} = sub { die "time out" };
 271             alarm $opt_timeout;
 272             $wait_pid = waitpid($pid, 0);
 273             alarm 0;
 274         };
 275
 276         if ($@ and $@ =~ /time out/)
 277         {
 278             kill_process($pid);
 279             $timed_out = 1;
 280         }
 281
 282         $current_test_pid = undef;
 283
 284         if ($opt_exit_munge == 1) {
 285             # signal information in the lower 8 bits, exit code above that
 286             $got_exit = ($? >> 8);
 287             $exit_signal = ($? & 255);
 288         } else {
 289             # user says not to munge the exit code
 290             $got_exit = $?;
 291             $exit_signal = 0;
 292         }
 293
 294         open (OUTPUT, "$jsout") or
 295            die "failed to open temporary file $jsout: $!\n";
 296         @output = <OUTPUT>;
 297         close (OUTPUT);
 298         unlink "$jsout";
 299         @output = grep (!/js\>/, @output);
 300
 301         $failure_lines = "";
 302         $bug_number = "";
 303         $status_lines = "";
 304         $result_lines = "";
 305
 306         foreach $line (@output) {
 307
 308             # watch for testcase to proclaim what exit code it expects to
 309             # produce (0 by default)
 310             if ($line =~ /expect(ed)?\s*exit\s*code\s*\:?\s*(\d+)/i) {
 311                 $expected_exit = $2;
 312                 push @expected_exit_list, ($expected_exit);
 313                 &dd ("Test case expects exit code $expected_exit");
 314             }
 315
 316             # watch for failures
 317             if ($line =~ /^\s*FAILED!/) {
 318                 $failure_lines .= $line;
 319             }
 320
 321             # and watch for bugnumbers
 322             # XXX This only allows 1 bugnumber per testfile, should be
 323             # XXX modified to allow for multiple.
 324             if ($line =~ /bugnumber\s*\:?\s*(.*)/i) {
 325                 my $bugline = $1;
 326                 $bugline =~ /(\d+)/;
 327                 $bug_number = $1;
 328             }
 329
 330             # and watch for status
 331             if ($line =~ /status/i) {
 332                 $status_lines .= $line;
 333             }
 334
 335             # collect result summary lines
 336             if ($line =~ /^jstest:/)
 337             {
 338                 $result_lines .= $line;
 339             }
 340         }
 341
 342         if (!@output) {
 343             @output = ("Testcase produced no output!");
 344         }
 345
 346         if ($opt_report_summarized_results) {
 347             print STDERR $result_lines;
 348             if ($timed_out)
 349             {
 350                 &report_summary_result($test, $bug_number, "FAILED TIMED OUT",
 351                                        "", "", "",
 352                                        join("\n",@output));
 353             }
 354             elsif (index(join(',', @expected_exit_list), $got_exit) == -1 ||
 355                    $exit_signal != 0) {
 356                 &report_summary_result($test, $bug_number, "FAILED",
 357                                        "",
 358                                        "Expected exit $expected_exit",
 359                                        "Actual exit $got_exit, signal $exit_signal",
 360                                        join("\n",@output));
 361             }
 362             elsif ($got_exit != 0) {
 363                 # abnormal termination but the test passed, so output a summary line
 364                 &report_summary_result($test, $bug_number, "PASSED",
 365                                        "",
 366                                        "Expected exit $expected_exit",
 367                                        "Actual exit $got_exit, signal $exit_signal",
 368                                        join("\n",@output));
 369             }
 370         }
 371         elsif ($timed_out) {
 372             # test was terminated due to timeout
 373             &report_failure ($test, "TIMED OUT ($opt_timeout seconds) " .
 374                              "Complete testcase output was:\n" .
 375                              join ("\n",@output), $bug_number);
 376         }
 377         elsif (index(join(',', @expected_exit_list), $got_exit) == -1 ||
 378                $exit_signal != 0) {
 379             # full testcase output dumped on mismatched exit codes,
 380             &report_failure ($test, "Expected exit code " .
 381                              "$expected_exit, got $got_exit\n" .
 382                              "Testcase terminated with signal $exit_signal\n" .
 383                              "Complete testcase output was:\n" .
 384                              join ("\n",@output), $bug_number);
 385         } elsif ($failure_lines) {
 386             # only offending lines if exit codes matched
 387             &report_failure ($test, "$status_lines\n".
 388                              "Failure messages were:\n$failure_lines",
 389                              $bug_number);
 390         }
 391
 392         &dd ("exit code $got_exit, exit signal $exit_signal.");
 393
 394         $tests_completed++;
 395     }
 396 }
 397
 398 sub write_results {
 399     my ($list_name, $neglist_name);
 400     my $completion_date = localtime;
 401     my $failure_pct = int(($failures_reported / $tests_completed) * 10000) /
 402       100;
 403     &dd ("Writing output to $opt_output_file.");
 404
 405     if ($#opt_test_list_files == -1) {
 406         $list_name = "All tests";
 407     } elsif ($#opt_test_list_files < 10) {
 408         $list_name = join (", ", @opt_test_list_files);
 409     } else {
 410         $list_name = "($#opt_test_list_files test files specified)";
 411     }
 412
 413     if ($#opt_neg_list_files == -1) {
 414         $neglist_name = "(none)";
 415     } elsif ($#opt_test_list_files < 10) {
 416         $neglist_name = join (", ", @opt_neg_list_files);
 417     } else {
 418         $neglist_name = "($#opt_neg_list_files skip files specified)";
 419     }
 420
 421     open (OUTPUT, "> $opt_output_file") ||
 422       die ("Could not create output file $opt_output_file");
 423
 424     print OUTPUT
 425       ("<html><head>\n" .
 426        "<title>Test results, $opt_engine_type</title>\n" .
 427        "</head>\n" .
 428        "<body bgcolor='white'>\n" .
 429        "<a name='tippy_top'></a>\n" .
 430        "<h2>Test results, $opt_engine_type</h2><br>\n" .
 431        "<p class='results_summary'>\n" .
 432        "Test List: $list_name<br>\n" .
 433        "Skip List: $neglist_name<br>\n" .
 434        ($#test_list + 1) . " test(s) selected, $tests_completed test(s) " .
 435        "completed, $failures_reported failures reported " .
 436        "($failure_pct% failed)<br>\n" .
 437        "Engine command line: $engine_command<br>\n" .
 438        "OS type: $os_type<br>\n");
 439
 440     if ($opt_engine_type =~ /^rhino/) {
 441         open (JAVAOUTPUT, $opt_java_path . "java -fullversion " .
 442               $redirect_command . " |");
 443         print OUTPUT <JAVAOUTPUT>;
 444         print OUTPUT "<BR>";
 445         close (JAVAOUTPUT);
 446     }
 447
 448     print OUTPUT
 449       ("Testcase execution time: $exec_time_string.<br>\n" .
 450        "Tests completed on $completion_date.<br><br>\n");
 451
 452     if ($failures_reported > 0) {
 453         my $output_file_failures = $opt_output_file;
 454         $output_file_failures =~ s/(.*)\.html$/$1-failures.txt/;
 455         open (OUTPUTFAILURES, "> $output_file_failures") ||
 456             die ("Could not create failure output file $output_file_failures");
 457         print OUTPUTFAILURES (join ("\n", @failed_tests));
 458         print OUTPUTFAILURES "\n";
 459         close OUTPUTFAILURES;
 460
 461         &status ("Wrote failures to '$output_file_failures'.");
 462
 463         print OUTPUT
 464           ("[ <a href='#fail_detail'>Failure Details</a> | " .
 465            "<a href='#retest_list'>Retest List</a> | " .
 466            "<a href='$opt_lxr_url" . "menu.html'>Test Selection Page</a> ]<br>\n" .
 467            "<hr>\n" .
 468            "<a name='fail_detail'></a>\n" .
 469            "<h2>Failure Details</h2><br>\n<dl>" .
 470            $html .
 471            "</dl>\n[ <a href='#tippy_top'>Top of Page</a> | " .
 472            "<a href='#fail_detail'>Top of Failures</a> ]<br>\n" .
 473            "<hr>\n" .
 474            "<a name='retest_list'></a>\n" .
 475            "<h2>Retest List</h2><br>\n" .
 476            "<pre>\n" .
 477            "# Retest List, $opt_engine_type, " .
 478            "generated $completion_date.\n" .
 479            "FAILURE: # Original test base was: $list_name.\n" .
 480            "FAILURE: # $tests_completed of " . ($#test_list + 1) .
 481            " test(s) were completed, " .
 482            "$failures_reported failures reported.\n" .
 483            "FAILURE: Engine command line: $engine_command<br>\n" .
 484            join ("\n", map { "FAILURE: $_" } @failed_tests) .
 485            "\n</pre>\n" .
 486            "[ <a href='#tippy_top'>Top of Page</a> | " .
 487            "<a href='#retest_list'>Top of Retest List</a> ]<br>\n");
 488     } else {
 489         print OUTPUT
 490           ("<h1>Whoop-de-doo, nothing failed!</h1>\n");
 491     }
 492
 493     print OUTPUT "</body>";
 494
 495     close (OUTPUT);
 496
 497     &status ("Wrote results to '$opt_output_file'.");
 498
 499     if ($opt_console_failures) {
 500         &status ("$failures_reported test(s) failed");
 501     }
 502
 503 }
 504
 505 sub parse_args {
 506     my ($option, $value, $lastopt);
 507
 508     &dd ("checking command line options.");
 509
 510     Getopt::Mixed::init ($options);
 511     $Getopt::Mixed::order = $Getopt::Mixed::RETURN_IN_ORDER;
 512
 513     while (($option, $value) = nextOption()) {
 514
 515         if ($option eq "b") {
 516             &dd ("opt: setting bugurl to '$value'.");
 517             $opt_bug_url = $value;
 518
 519         } elsif ($option eq "c") {
 520             &dd ("opt: setting classpath to '$value'.");
 521             $opt_classpath = $value;
 522
 523         } elsif (($option eq "e") || (($option eq "") && ($lastopt eq "e"))) {
 524             &dd ("opt: adding engine $value.");
 525             push (@opt_engine_list, $value);
 526
 527         } elsif ($option eq "f") {
 528             if (!$value) {
 529                 die ("Output file cannot be null.\n");
 530             }
 531             &dd ("opt: setting output file to '$value'.");
 532             $opt_user_output_file = 1;
 533             $opt_output_file = $value;
 534
 535         } elsif ($option eq "h") {
 536             &usage;
 537
 538         } elsif ($option eq "j") {
 539             if (!($value =~ /[\/\\]$/)) {
 540                 $value .= "/";
 541             }
 542             &dd ("opt: setting java path to '$value'.");
 543             $opt_java_path = $value;
 544
 545         } elsif ($option eq "k") {
 546             &dd ("opt: displaying failures on console.");
 547             $opt_console_failures=1;
 548
 549         } elsif ($option eq "K") {
 550             &dd ("opt: displaying failures on console as single line.");
 551             $opt_console_failures=1;
 552             $opt_console_failures_line=1;
 553
 554         } elsif ($option eq "R") {
 555             &dd ("opt: Report summarized test results.");
 556             $opt_report_summarized_results=1;
 557
 558         } elsif ($option eq "l" || (($option eq "") && ($lastopt eq "l"))) {
 559             $option = "l";
 560             &dd ("opt: adding test list '$value'.");
 561             push (@opt_test_list_files, $value);
 562
 563         } elsif ($option eq "L" || (($option eq "") && ($lastopt eq "L"))) {
 564             $option = "L";
 565             &dd ("opt: adding negative list '$value'.");
 566             push (@opt_neg_list_files, $value);
 567
 568         } elsif ($option eq "o") {
 569             $opt_engine_params = $value;
 570             &dd ("opt: setting engine params to '$opt_engine_params'.");
 571
 572         } elsif ($option eq "p") {
 573             $opt_suite_path = $value;
 574
 575             if ($os_type eq "MAC") {
 576                 if (!($opt_suite_path =~ /\:$/)) {
 577                     $opt_suite_path .= ":";
 578                 }
 579             } else {
 580                 if (!($opt_suite_path =~ /[\/\\]$/)) {
 581                     $opt_suite_path .= "/";
 582                 }
 583             }
 584
 585             &dd ("opt: setting suite path to '$opt_suite_path'.");
 586
 587         } elsif ($option eq "s") {
 588             $opt_shell_path = $value;
 589             &dd ("opt: setting shell path to '$opt_shell_path'.");
 590
 591         } elsif ($option eq "t") {
 592             &dd ("opt: tracing output.  (console failures at no extra charge.)");
 593             $opt_console_failures = 1;
 594             $opt_trace = 1;
 595
 596         } elsif ($option eq "u") {
 597             &dd ("opt: setting lxr url to '$value'.");
 598             $opt_lxr_url = $value;
 599
 600         } elsif ($option eq "x") {
 601             &dd ("opt: turning off exit munging.");
 602             $opt_exit_munge = 0;
 603
 604         } elsif ($option eq "T") {
 605             $opt_timeout = $value;
 606             &dd ("opt: setting timeout to $opt_timeout.");
 607
 608         } elsif ($option eq "n") {
 609             &dd ("opt: enabling narcissus.");
 610             $opt_enable_narcissus = 1;
 611             if ($value) {
 612                 $opt_narcissus_path = $value;
 613             }
 614
 615         } elsif ($option eq "Q") {
 616             &dd ("opt: disabling interrupt handler.");
 617             $opt_no_quit = 1;
 618
 619         } else {
 620             &dd ("opt: unknown option $option '$value'.");
 621             &usage;
 622         }
 623
 624         $lastopt = $option;
 625
 626     }
 627
 628     Getopt::Mixed::cleanup();
 629
 630     if ($#opt_engine_list == -1) {
 631         die "You must select a shell to test in.\n";
 632     }
 633
 634 }
 635
 636 #
 637 # print the arguments that this script expects
 638 #
 639 sub usage {
 640     print STDERR
 641       ("\nusage: $0 [<options>] \n" .
 642        "(-b|--bugurl)             Bugzilla URL.\n" .
 643        "                          (default is $opt_bug_url)\n" .
 644        "(-c|--classpath)          Classpath (Rhino only.)\n" .
 645        "(-e|--engine) <type> ...  Specify the type of engine(s) to test.\n" .
 646        "                          <type> is one or more of\n" .
 647        "                          (smopt|smdebug|lcopt|lcdebug|xpcshell|" .
 648        "rhino|rhinoi|rhinoms|rhinomsi|rhino9|rhinoms9).\n" .
 649        "(-f|--file) <file>        Redirect output to file named <file>.\n" .
 650        "                          (default is " .
 651        "results-<engine-type>-<date-stamp>.html)\n" .
 652        "(-h|--help)               Print this message.\n" .
 653        "(-j|--javapath)           Location of java executable.\n" .
 654        "(-k|--confail)            Log failures to console (also.)\n" .
 655        "(-K|--linefail)           Log failures to console as single line (also.)\n" .
 656        "(-R|--report)             Report summarized test results.\n" .
 657        "(-l|--list) <file> ...    List of tests to execute.\n" .
 658        "(-L|--neglist) <file> ... List of tests to skip.\n" .
 659        "(-o|--opt) <options>      Options to pass to the JavaScript engine.\n" .
 660        "                          (Make sure to quote them!)\n" .
 661        "(-p|--testpath) <path>    Root of the test suite. (default is ./)\n" .
 662        "(-s|--shellpath) <path>   Location of JavaScript shell.\n" .
 663        "(-t|--trace)              Trace script execution.\n" .
 664        "(-T|--timeout) <seconds>  Time in seconds before the test is terminated.\n" .
 665        "                          (default is 3600).\n" .
 666        "(-u|--lxrurl) <url>       Complete URL to tests subdirectory on lxr.\n" .
 667        "                          (default is $opt_lxr_url)\n" .
 668        "(-x|--noexitmunge)        Don't do exit code munging (try this if it\n" .
 669        "                          seems like your exit codes are turning up\n" .
 670        "                          as exit signals.)\n" .
 671        "(-n|--narcissus)[=<path>] Run the test suite through Narcissus, run\n" .
 672        "                          through the given shell. The optional path\n".
 673        "                          is the path to Narcissus' js.js file.\n".
 674        "(-Q|--noquitinthandler)   Do not prompt user to Quit, Report or Continue\n".
 675        "                          in the event of a user interrupt.\n"
 676        );
 677     exit (1);
 678
 679 }
 680
 681 #
 682 # get the shell command used to start the (either) engine
 683 #
 684 sub get_engine_command {
 685
 686     my $retval;
 687
 688     if ($opt_engine_type eq "rhino") {
 689         &dd ("getting rhino engine command.");
 690         $opt_rhino_opt = 0;
 691         $opt_rhino_ms = 0;
 692         $retval = &get_rhino_engine_command;
 693     } elsif ($opt_engine_type eq "rhinoi") {
 694         &dd ("getting rhinoi engine command.");
 695         $opt_rhino_opt = -1;
 696         $opt_rhino_ms = 0;
 697         $retval = &get_rhino_engine_command;
 698     } elsif ($opt_engine_type eq "rhino9") {
 699         &dd ("getting rhino engine command.");
 700         $opt_rhino_opt = 9;
 701         $opt_rhino_ms = 0;
 702         $retval = &get_rhino_engine_command;
 703     } elsif ($opt_engine_type eq "rhinoms") {
 704         &dd ("getting rhinoms engine command.");
 705         $opt_rhino_opt = 0;
 706         $opt_rhino_ms = 1;
 707         $retval = &get_rhino_engine_command;
 708     } elsif ($opt_engine_type eq "rhinomsi") {
 709         &dd ("getting rhinomsi engine command.");
 710         $opt_rhino_opt = -1;
 711         $opt_rhino_ms = 1;
 712         $retval = &get_rhino_engine_command;
 713     } elsif ($opt_engine_type eq "rhinoms9") {
 714         &dd ("getting rhinomsi engine command.");
 715         $opt_rhino_opt = 9;
 716         $opt_rhino_ms = 1;
 717         $retval = &get_rhino_engine_command;
 718     } elsif ($opt_engine_type eq "xpcshell") {
 719         &dd ("getting xpcshell engine command.");
 720         $retval = &get_xpc_engine_command;
 721     } elsif ($opt_engine_type =~ /^lc(opt|debug)$/) {
 722         &dd ("getting liveconnect engine command.");
 723         $retval = &get_lc_engine_command;
 724     } elsif ($opt_engine_type =~ /^sm(opt|debug)$/) {
 725         &dd ("getting spidermonkey engine command.");
 726         $retval = &get_sm_engine_command;
 727     } elsif ($opt_engine_type =~ /^ep(opt|debug)$/) {
 728         &dd ("getting epimetheus engine command.");
 729         $retval = &get_ep_engine_command;
 730     } else {
 731         die ("Unknown engine type selected, '$opt_engine_type'.\n");
 732     }
 733
 734     $retval .= " $opt_engine_params";
 735
 736     if ($opt_enable_narcissus == 1) {
 737         my $narcissus_path = &get_narcissus_path;
 738         $retval .= " -f $narcissus_path";
 739     }
 740
 741     &dd ("got '$retval'");
 742
 743     return $retval;
 744 }
 745
 746 #
 747 # get the path to the Narcissus js.js file.
 748 #
 749 sub get_narcissus_path {
 750     my $retval;
 751
 752     if ($opt_narcissus_path) {
 753         $retval = $opt_narcissus_path;
 754     } else {
 755         # For now, just assume that we're in js/tests.
 756         $retval = "../narcissus/js.js";
 757     }
 758
 759     if (!-e $retval) {
 760         # XXX if it didn't exist, try something more fancy?
 761         die "Unable to find Narcissus' js.js at $retval";
 762     }
 763
 764     return $retval;
 765 }
 766
 767 #
 768 # get the shell command used to run rhino
 769 #
 770 sub get_rhino_engine_command {
 771     my $retval = $opt_java_path . ($opt_rhino_ms ? "jview " : "java ");
 772
 773     if ($opt_shell_path) {
 774         $opt_classpath = ($opt_classpath) ?
 775           $opt_classpath . ":" . $opt_shell_path :
 776             $opt_shell_path;
 777     }
 778
 779     if ($opt_classpath) {
 780         $retval .= ($opt_rhino_ms ? "/cp:p" : "-classpath") . " $opt_classpath ";
 781     }
 782
 783     $retval .= "org.mozilla.javascript.tools.shell.Main";
 784
 785     if ($opt_rhino_opt) {
 786         $retval .= " -opt $opt_rhino_opt";
 787     }
 788
 789     return $retval;
 790
 791 }
 792
 793 #
 794 # get the shell command used to run xpcshell
 795 #
 796 sub get_xpc_engine_command {
 797     my $retval;
 798     my $m5_home = @ENV{"MOZILLA_FIVE_HOME"} ||
 799       die ("You must set MOZILLA_FIVE_HOME to use the xpcshell" ,
 800            (!$unixish) ? "." : ", also " .
 801            "setting LD_LIBRARY_PATH to the same directory may get rid of " .
 802            "any 'library not found' errors.\n");
 803
 804     if (($unixish) && (!@ENV{"LD_LIBRARY_PATH"})) {
 805         print STDERR "-#- WARNING: LD_LIBRARY_PATH is not set, xpcshell may " .
 806           "not be able to find the required components.\n";
 807     }
 808
 809     if (!($m5_home =~ /[\/\\]$/)) {
 810         $m5_home .= "/";
 811     }
 812
 813     $retval = $m5_home . "xpcshell";
 814
 815     if ($os_type eq "WIN") {
 816         $retval .= ".exe";
 817     }
 818
 819     $retval = &xp_path($retval);
 820
 821     if (($os_type ne "MAC") && !(-x $retval)) {
 822         # mac doesn't seem to deal with -x correctly
 823         die ($retval . " is not a valid executable on this system.\n");
 824     }
 825
 826     return $retval;
 827
 828 }
 829
 830 #
 831 # get the shell command used to run spidermonkey
 832 #
 833 sub get_sm_engine_command {
 834     my $retval;
 835
 836     # Look for Makefile.ref style make first.
 837     # (On Windows, spidermonkey can be made by two makefiles, each putting the
 838     # executable in a diferent directory, under a different name.)
 839
 840     if ($opt_shell_path) {
 841         # if the user provided a path to the shell, return that.
 842         $retval = $opt_shell_path;
 843
 844     } else {
 845
 846         if ($os_type eq "MAC") {
 847             $retval = $opt_suite_path . ":src:macbuild:JS";
 848         } else {
 849             $retval = $opt_suite_path . "../src/";
 850             opendir (SRC_DIR_FILES, $retval);
 851             my @src_dir_files = readdir(SRC_DIR_FILES);
 852             closedir (SRC_DIR_FILES);
 853
 854             my ($dir, $object_dir);
 855             my $pattern = ($opt_engine_type eq "smdebug") ?
 856               'DBG.OBJ' : 'OPT.OBJ';
 857
 858             # scan for the first directory matching
 859             # the pattern expected to hold this type (debug or opt) of engine
 860             foreach $dir (@src_dir_files) {
 861                 if ($dir =~ $pattern) {
 862                     $object_dir = $dir;
 863                     last;
 864                 }
 865             }
 866
 867             if (!$object_dir && $os_type ne "WIN") {
 868                 die ("Could not locate an object directory in $retval " .
 869                      "matching the pattern *$pattern.  Have you built the " .
 870                      "engine?\n");
 871             }
 872
 873             if (!(-x $retval . $object_dir . "/js.exe") && ($os_type eq "WIN")) {
 874                 # On windows, you can build with js.mak as well as Makefile.ref
 875                 # (Can you say WTF boys and girls?  I knew you could.)
 876                 # So, if the exe the would have been built by Makefile.ref isn't
 877                 # here, check for the js.mak version before dying.
 878                 if ($opt_shell_path) {
 879                     $retval = $opt_shell_path;
 880                     if (!($retval =~ /[\/\\]$/)) {
 881                         $retval .= "/";
 882                     }
 883                 } else {
 884                     if ($opt_engine_type eq "smopt") {
 885                         $retval = "../src/Release/";
 886                     } else {
 887                         $retval = "../src/Debug/";
 888                     }
 889                 }
 890
 891                 $retval .= "jsshell.exe";
 892
 893             } else {
 894                 $retval .= $object_dir . "/js";
 895                 if ($os_type eq "WIN") {
 896                     $retval .= ".exe";
 897                 }
 898             }
 899         } # mac/ not mac
 900
 901         $retval = &xp_path($retval);
 902
 903     } # (user provided a path)
 904
 905
 906     if (($os_type ne "MAC") && !(-x $retval)) {
 907         # mac doesn't seem to deal with -x correctly
 908         die ($retval . " is not a valid executable on this system.\n");
 909     }
 910
 911     return $retval;
 912
 913 }
 914
 915 #
 916 # get the shell command used to run epimetheus
 917 #
 918 sub get_ep_engine_command {
 919     my $retval;
 920
 921     if ($opt_shell_path) {
 922         # if the user provided a path to the shell, return that -
 923         $retval = $opt_shell_path;
 924
 925     } else {
 926         my $dir;
 927         my $os;
 928         my $debug;
 929         my $opt;
 930         my $exe;
 931
 932         $dir = $opt_suite_path . "../../js2/src/";
 933
 934         if ($os_type eq "MAC") {
 935             #
 936             # On the Mac, the debug and opt builds lie in the same directory -
 937             #
 938             $os = "macbuild:";
 939             $debug = "";
 940             $opt = "";
 941             $exe = "JS2";
 942         } elsif ($os_type eq "WIN") {
 943             $os = "winbuild/Epimetheus/";
 944             $debug = "Debug/";
 945             $opt = "Release/";
 946             $exe = "Epimetheus.exe";
 947         } else {
 948             $os = "";
 949             $debug = "";
 950             $opt = "";    # <<<----- XXX THIS IS NOT RIGHT! CHANGE IT!
 951             $exe = "epimetheus";
 952         }
 953
 954
 955         if ($opt_engine_type eq "epdebug") {
 956             $retval = $dir . $os . $debug . $exe;
 957         } else {
 958             $retval = $dir . $os . $opt . $exe;
 959         }
 960
 961         $retval = &xp_path($retval);
 962
 963     }# (user provided a path)
 964
 965
 966     if (($os_type ne "MAC") && !(-x $retval)) {
 967         # mac doesn't seem to deal with -x correctly
 968         die ($retval . " is not a valid executable on this system.\n");
 969     }
 970
 971     return $retval;
 972 }
 973
 974 #
 975 # get the shell command used to run the liveconnect shell
 976 #
 977 sub get_lc_engine_command {
 978     my $retval;
 979
 980     if ($opt_shell_path) {
 981         $retval = $opt_shell_path;
 982     } else {
 983         if ($os_type eq "MAC") {
 984             die "Don't know how to run the lc shell on the mac yet.\n";
 985         } else {
 986             $retval = $opt_suite_path . "../src/liveconnect/";
 987             opendir (SRC_DIR_FILES, $retval);
 988             my @src_dir_files = readdir(SRC_DIR_FILES);
 989             closedir (SRC_DIR_FILES);
 990
 991             my ($dir, $object_dir);
 992             my $pattern = ($opt_engine_type eq "lcdebug") ?
 993               'DBG.OBJ' : 'OPT.OBJ';
 994
 995             foreach $dir (@src_dir_files) {
 996                 if ($dir =~ $pattern) {
 997                     $object_dir = $dir;
 998                     last;
 999                 }
1000             }
1001
1002             if (!$object_dir) {
1003                 die ("Could not locate an object directory in $retval " .
1004                      "matching the pattern *$pattern.  Have you built the " .
1005                      "engine?\n");
1006             }
1007
1008             $retval .= $object_dir . "/";
1009
1010             if ($os_type eq "WIN") {
1011                 $retval .= "lcshell.exe";
1012             } else {
1013                 $retval .= "lcshell";
1014             }
1015         } # mac/ not mac
1016
1017         $retval = &xp_path($retval);
1018
1019     } # (user provided a path)
1020
1021
1022     if (($os_type ne "MAC") && !(-x $retval)) {
1023         # mac doesn't seem to deal with -x correctly
1024         die ("$retval is not a valid executable on this system.\n");
1025     }
1026
1027     return $retval;
1028
1029 }
1030
1031 sub get_os_type {
1032
1033     if ("\n" eq "\015") {
1034         return "MAC";
1035     }
1036
1037     my $uname = `uname -a`;
1038
1039     if ($uname =~ /WIN/) {
1040         $uname = "WIN";
1041     } else {
1042         chop $uname;
1043     }
1044
1045     &dd ("get_os_type returning '$uname'.");
1046     return $uname;
1047
1048 }
1049
1050 sub get_test_list {
1051     my @test_list;
1052     my @neg_list;
1053
1054     if ($#opt_test_list_files > -1) {
1055         my $list_file;
1056
1057         &dd ("getting test list from user specified source.");
1058
1059         foreach $list_file (@opt_test_list_files) {
1060             push (@test_list, &expand_user_test_list($list_file));
1061         }
1062     } else {
1063         &dd ("no list file, groveling in '$opt_suite_path'.");
1064
1065         @test_list = &get_default_test_list($opt_suite_path);
1066     }
1067
1068     if ($#opt_neg_list_files > -1) {
1069         my $list_file;
1070         my $orig_size = $#test_list + 1;
1071         my $actually_skipped;
1072
1073         &dd ("getting negative list from user specified source.");
1074
1075         foreach $list_file (@opt_neg_list_files) {
1076             push (@neg_list, &expand_user_test_list($list_file));
1077         }
1078
1079         @test_list = &subtract_arrays (\@test_list, \@neg_list);
1080
1081         $actually_skipped = $orig_size - ($#test_list + 1);
1082
1083         &dd ($actually_skipped . " of " . $orig_size .
1084              " tests will be skipped.");
1085         &dd ((($#neg_list + 1) - $actually_skipped) . " skip tests were " .
1086              "not actually part of the test list.");
1087
1088     }
1089
1090
1091     # Don't run any shell.js files as tests; they are only utility files
1092     @test_list = grep (!/shell\.js$/, @test_list);
1093
1094     # Don't run any browser.js files as tests; they are only utility files
1095     @test_list = grep (!/browser\.js$/, @test_list);
1096
1097     # Don't run any jsref.js files as tests; they are only utility files
1098     @test_list = grep (!/jsref\.js$/, @test_list);
1099
1100     return @test_list;
1101
1102 }
1103
1104 #
1105 # reads $list_file, storing non-comment lines into an array.
1106 # lines in the form suite_dir/[*] or suite_dir/test_dir/[*] are expanded
1107 # to include all test files under the specified directory
1108 #
1109 sub expand_user_test_list {
1110     my ($list_file) = @_;
1111     my @retval = ();
1112
1113     #
1114     # Trim off the leading path separator that begins relative paths on the Mac.
1115     # Each path will get concatenated with $opt_suite_path, which ends in one.
1116     #
1117     # Also note:
1118     #
1119     # We will call expand_test_list_entry(), which does pattern-matching on $list_file.
1120     # This will make the pattern-matching the same as it would be on Linux/Windows -
1121     #
1122     if ($os_type eq "MAC") {
1123         $list_file =~ s/^$path_sep//;
1124     }
1125
1126     if ($list_file =~ /\.js$/ || -d $opt_suite_path . $list_file) {
1127
1128         push (@retval, &expand_test_list_entry($list_file));
1129
1130     } else {
1131
1132         open (TESTLIST, $list_file) ||
1133           die("Error opening test list file '$list_file': $!\n");
1134
1135         while (<TESTLIST>) {
1136             s/\r*\n*$//;
1137             if (!(/\s*\#/)) {
1138                 # It's not a comment, so process it
1139                 push (@retval, &expand_test_list_entry($_));
1140             }
1141         }
1142
1143         close (TESTLIST);
1144
1145     }
1146
1147     return @retval;
1148
1149 }
1150
1151
1152 #
1153 # Currently expect all paths to be RELATIVE to the top-level tests directory.
1154 # One day, this should be improved to allow absolute paths as well -
1155 #
1156 sub expand_test_list_entry {
1157     my ($entry) = @_;
1158     my @retval;
1159
1160     if ($entry =~ /\.js$/) {
1161         # it's a regular entry, add it to the list
1162         if (-f $opt_suite_path . $entry) {
1163             push (@retval, $entry);
1164         } else {
1165             status ("testcase '$entry' not found.");
1166         }
1167     } elsif ($entry =~ /(.*$path_sep[^\*][^$path_sep]*)$path_sep?\*?$/) {
1168         # Entry is in the form suite_dir/test_dir[/*]
1169         # so iterate all tests under it
1170         my $suite_and_test_dir = $1;
1171         my @test_files = &get_js_files ($opt_suite_path .
1172                                         $suite_and_test_dir);
1173         my $i;
1174
1175         foreach $i (0 .. $#test_files) {
1176             $test_files[$i] = $suite_and_test_dir . $path_sep .
1177               $test_files[$i];
1178         }
1179
1180         splice (@retval, $#retval + 1, 0, @test_files);
1181
1182     } elsif ($entry =~ /([^\*][^$path_sep]*)$path_sep?\*?$/) {
1183         # Entry is in the form suite_dir[/*]
1184         # so iterate all test dirs and tests under it
1185         my $suite = $1;
1186         my @test_dirs = &get_subdirs ($opt_suite_path . $suite);
1187         my $test_dir;
1188
1189         foreach $test_dir (@test_dirs) {
1190             my @test_files = &get_js_files ($opt_suite_path . $suite .
1191                                             $path_sep . $test_dir);
1192             my $i;
1193
1194             foreach $i (0 .. $#test_files) {
1195                 $test_files[$i] = $suite . $path_sep . $test_dir . $path_sep .
1196                   $test_files[$i];
1197             }
1198
1199             splice (@retval, $#retval + 1, 0, @test_files);
1200         }
1201
1202     } else {
1203         die ("Don't know what to do with list entry '$entry'.\n");
1204     }
1205
1206     return @retval;
1207
1208 }
1209
1210 #
1211 # Grovels through $suite_path, searching for *all* test files.  Used when the
1212 # user doesn't supply a test list.
1213 #
1214 sub get_default_test_list {
1215     my ($suite_path) = @_;
1216     my @suite_list = &get_subdirs($suite_path);
1217     my $suite;
1218     my @retval;
1219
1220     foreach $suite (@suite_list) {
1221         my @test_dir_list = get_subdirs ($suite_path . $suite);
1222         my $test_dir;
1223
1224         foreach $test_dir (@test_dir_list) {
1225             my @test_list = get_js_files ($suite_path . $suite . $path_sep .
1226                                           $test_dir);
1227             my $test;
1228
1229             foreach $test (@test_list) {
1230                 $retval[$#retval + 1] = $suite . $path_sep . $test_dir .
1231                   $path_sep . $test;
1232             }
1233         }
1234     }
1235
1236     return @retval;
1237
1238 }
1239
1240 #
1241 # generate an output file name based on the date
1242 #
1243 sub get_tempfile_name {
1244     my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
1245       &get_padded_time (localtime);
1246     my $rv;
1247
1248     if ($os_type ne "MAC") {
1249         $rv = "results-" . $year . "-" . $mon . "-" . $mday . "-" . $hour .
1250           $min . $sec . "-" . $opt_engine_type;
1251     } else {
1252         $rv = "res-" . $year . $mon . $mday . $hour . $min . $sec . "-" .
1253           $opt_engine_type
1254     }
1255
1256     return $rv . ".html";
1257 }
1258
1259 sub get_padded_time {
1260     my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = @_;
1261
1262     $mon++;
1263     $mon = &zero_pad($mon);
1264     $year += 1900;
1265     $mday= &zero_pad($mday);
1266     $sec = &zero_pad($sec);
1267     $min = &zero_pad($min);
1268     $hour = &zero_pad($hour);
1269
1270     return ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst);
1271
1272 }
1273
1274 sub zero_pad {
1275     my ($string) = @_;
1276
1277     $string = ($string < 10) ? "0" . $string : $string;
1278     return $string;
1279 }
1280
1281 sub subtract_arrays {
1282     my ($whole_ref, $part_ref) = @_;
1283     my @whole = @$whole_ref;
1284     my @part = @$part_ref;
1285     my $line;
1286
1287     foreach $line (@part) {
1288         @whole = grep (!/$line/, @whole);
1289     }
1290
1291     return @whole;
1292
1293 }
1294
1295 #
1296 # Convert unix path to mac style.
1297 #
1298 sub unix_to_mac {
1299     my ($path) = @_;
1300     my @path_elements = split ("/", $path);
1301     my $rv = "";
1302     my $i;
1303
1304     foreach $i (0 .. $#path_elements) {
1305         if ($path_elements[$i] eq ".") {
1306             if (!($rv =~ /\:$/)) {
1307                 $rv .= ":";
1308             }
1309         } elsif ($path_elements[$i] eq "..") {
1310             if (!($rv =~ /\:$/)) {
1311                 $rv .= "::";
1312             } else {
1313                 $rv .= ":";
1314             }
1315         } elsif ($path_elements[$i] ne "") {
1316             $rv .= $path_elements[$i] . ":";
1317         }
1318
1319     }
1320
1321     $rv =~ s/\:$//;
1322
1323     return $rv;
1324 }
1325
1326 #
1327 # Convert unix path to win style.
1328 #
1329 sub unix_to_win {
1330   my ($path) = @_;
1331
1332   if ($path_sep ne $win_sep) {
1333       $path =~ s/$path_sep/$win_sep/g;
1334   }
1335
1336   return $path;
1337 }
1338
1339 #
1340 # Windows shells require "/" or "\" as path separator.
1341 # Find out the one used in the current Windows shell.
1342 #
1343 sub get_win_sep {
1344   my $path = $ENV{"PATH"} || $ENV{"Path"} || $ENV{"path"};
1345   $path =~ /\\|\//;
1346   return $&;
1347 }
1348
1349 #
1350 # Convert unix path to correct style based on platform.
1351 #
1352 sub xp_path {
1353     my ($path) = @_;
1354
1355     if ($os_type eq "MAC") {
1356         return &unix_to_mac($path);
1357     } elsif($os_type eq "WIN") {
1358         return &unix_to_win($path);
1359     } else {
1360         return $path;
1361     }
1362 }
1363
1364 #
1365 # given a directory, return an array of all subdirectories
1366 #
1367 sub get_subdirs {
1368     my ($dir)  = @_;
1369     my @subdirs;
1370
1371     if ($os_type ne "MAC") {
1372         if (!($dir =~ /\/$/)) {
1373             $dir = $dir . "/";
1374         }
1375     } else {
1376         if (!($dir =~ /\:$/)) {
1377             $dir = $dir . ":";
1378         }
1379     }
1380     opendir (DIR, $dir) || die ("couldn't open directory $dir: $!");
1381     my @testdir_contents = readdir(DIR);
1382     closedir(DIR);
1383
1384     foreach (@testdir_contents) {
1385         if ((-d ($dir . $_)) && ($_ ne 'CVS') && ($_ ne '.') && ($_ ne '..')) {
1386             @subdirs[$#subdirs + 1] = $_;
1387         }
1388     }
1389
1390     return @subdirs;
1391 }
1392
1393 #
1394 # given a directory, return an array of all the js files that are in it.
1395 #
1396 sub get_js_files {
1397     my ($test_subdir) = @_;
1398     my (@js_file_array, @subdir_files);
1399
1400     opendir (TEST_SUBDIR, $test_subdir) || die ("couldn't open directory " .
1401                                                 "$test_subdir: $!");
1402     @subdir_files = readdir(TEST_SUBDIR);
1403     closedir( TEST_SUBDIR );
1404
1405     foreach (@subdir_files) {
1406         if ($_ =~ /\.js$/) {
1407             $js_file_array[$#js_file_array+1] = $_;
1408         }
1409     }
1410
1411     return @js_file_array;
1412 }
1413
1414 sub report_failure {
1415     my ($test, $message, $bug_number) = @_;
1416     my $bug_line = "";
1417
1418     $failures_reported++;
1419
1420     $message =~ s/\n+/\n/g;
1421     $test =~ s/\:/\//g;
1422
1423     if ($opt_console_failures) {
1424         if ($opt_console_failures_line) {
1425             # report_summary_result increments $failures_reported
1426             # decrement here to prevent overcounting of failures
1427             $failures_reported--;
1428             my $linemessage = $message;
1429             $linemessage =~ s/[\n\r]+/ /mg;
1430             $bug_number = "none" unless $bug_number;
1431             &report_summary_result($test, $bug_number, "FAILED",
1432                                    "",
1433                                    "",
1434                                    "",
1435                                    $linemessage);
1436         } elsif($bug_number) {
1437             print STDERR ("*-* Testcase $test failed:\nBug Number $bug_number".
1438                           "\n$message\n");
1439         } else {
1440             print STDERR ("*-* Testcase $test failed:\n$message\n");
1441         }
1442     }
1443
1444     $message =~ s/&/&amp;/g;
1445     $message =~ s/</&lt;/g;
1446     $message =~ s/>/&gt;/g;
1447     $message =~ s/\n/<br>\n/g;
1448
1449     if ($bug_number) {
1450         my $bug_url = ($bug_number =~ /^\d+$/) ? "$opt_bug_url$bug_number" : $bug_number;
1451         $bug_line = "<a href='$bug_url' target='other_window'>".
1452                     "Bug Number $bug_number</a>";
1453     }
1454
1455     if ($opt_lxr_url) {
1456         $test =~ /\/?([^\/]+\/[^\/]+\/[^\/]+)$/;
1457         $test = $1;
1458         $html .= "<dd><b>".
1459           "Testcase <a target='other_window' href='$opt_lxr_url$test'>$1</a> " .
1460             "failed</b> $bug_line<br>\n";
1461     } else {
1462         $html .= "<dd><b>".
1463           "Testcase $test failed</b> $bug_line<br>\n";
1464     }
1465
1466     $html .= " [ ";
1467
1468     $html .= "<a href='#tippy_top'>Top of Page</a> ]<br>\n" .
1469           "<tt>$message</tt><br>\n";
1470
1471     @failed_tests[$#failed_tests + 1] = $test;
1472
1473 }
1474
1475 sub dd {
1476
1477     if ($opt_trace) {
1478         print ("-*- ", @_ , "\n");
1479     }
1480
1481 }
1482
1483 sub status {
1484
1485     print ("-#- ", @_ , "\n");
1486
1487 }
1488
1489 sub int_handler {
1490     my $resp;
1491
1492     if ($current_test_pid)
1493     {
1494         print "User Interrupt: killing process $current_test_pid\n";
1495         kill_process($current_test_pid);
1496     }
1497
1498     do {
1499         print STDERR ("\n*** User Break: Just [Q]uit, Quit and [R]eport, [C]ontinue ?");
1500         $resp = <STDIN>;
1501     } until ($resp =~ /[QqRrCc]/);
1502
1503     if ($resp =~ /[Qq]/) {
1504         print ("User Exit.  No results were generated.\n");
1505         exit;
1506     } elsif ($resp =~ /[Rr]/) {
1507         $user_exit = 1;
1508     }
1509
1510 }
1511
1512 # XXX: These functions were pulled from
1513 # lxr.mozilla.org/mozilla/source/tools/tinderbox/build-seamonkey-util.pl
1514 # need a general reusable library of routines for use in all test programs.
1515
1516 sub kill_process {
1517     my ($target_pid) = @_;
1518     my $start_time = time;
1519
1520     # Try to kill and wait 10 seconds, then try a kill -9
1521     my $sig;
1522     for $sig ('TERM', 'KILL') {
1523         print "kill $sig $target_pid\n";
1524         kill $sig => $target_pid;
1525         my $interval_start = time;
1526         while (time - $interval_start < 10) {
1527             # the following will work with 'cygwin' perl on win32, but not
1528             # with 'MSWin32' (ActiveState) perl
1529             my $pid = waitpid($target_pid, POSIX::WNOHANG());
1530             if (($pid == $target_pid and POSIX::WIFEXITED($?)) or $pid == -1) {
1531                 my $secs = time - $start_time;
1532                 $secs = $secs == 1 ? '1 second' : "$secs seconds";
1533                 return;
1534             }
1535             sleep 1;
1536         }
1537     }
1538     die "Unable to kill process: $target_pid";
1539 }
1540
1541 sub report_summary_result
1542 {
1543     my ($test, $bug_number, $result, $description,
1544         $expected, $actual, $reason) = @_;
1545
1546     $description =~ s/[\n\r]+/ /mg;
1547     $expected    =~ s/[\n\r]+/ /mg;
1548     $actual      =~ s/[\n\r]+/ /mg;
1549     $reason      =~ s/[\n\r]+/ /mg;
1550
1551     if ($result !~ /PASSED/)
1552     {
1553         $failures_reported++;
1554     }
1555
1556     print STDERR ("jstest: $test " .
1557                   "bug: $bug_number " .
1558                   "result: $result " .
1559                   "type: shell " .
1560                   "description: $description " .
1561                   "expected: $expected " .
1562                   "actual: $actual " .
1563                   "reason: $reason" .
1564                   "\n");
1565
1566 }