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