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