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 (at] netscape.com> 33 # 34 # Second cut at runtests.pl script originally by 35 # Christine Begle (cbegle (at] 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 } 1336
