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