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