tests/mozilla/jsDriver.pl

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