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= ""; 68 69# command line option definition 70my $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 75if ($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 85my $user_exit = 0; 86my ($engine_command, $html, $failures_reported, $tests_completed, 87 $exec_time_string); 88my @failed_tests; 89my @test_list = &get_test_list; 90 91if ($#test_list == -1) { 92 die ("Nothing to test.\n"); 93} 94 95if ($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 108sub 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 149sub 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 275sub 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 360close (OUTPUT); 361 362&status ("Wrote results to '$opt_output_file'."); 363 364if ($opt_console_failures) { 365 &status ("$failures_reported test(s) failed"); 366} 367 368} 369 370sub 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# 484sub 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# 520sub 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# 584sub 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# 610sub 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# 647sub 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# 665sub 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# 750sub 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# 809sub 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 863sub 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 882sub 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# 932sub 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# 979sub 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# 1037sub 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# 1066sub 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 1082sub 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 1097sub zero_pad { 1098 my ($string) = @_; 1099 1100 $string = ($string < 10) ? "0" . $string : $string; 1101 return $string; 1102} 1103 1104sub 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# 1121sub 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# 1152sub 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# 1166sub 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# 1175sub 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 1187sub 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# 1207sub 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# 1236sub 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 1254sub 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 1306sub dd { 1307 1308 if ($opt_trace) { 1309 print ("-*- ", @_ , "\n"); 1310 } 1311 1312} 1313 1314sub status { 1315 1316 print ("-#- ", @_ , "\n"); 1317 1318} 1319 1320sub 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