diff --git a/mozilla/js/perf/README-jsPerformance.html b/mozilla/js/perf/README-jsPerformance.html new file mode 100644 index 00000000000..cf5402168af --- /dev/null +++ b/mozilla/js/perf/README-jsPerformance.html @@ -0,0 +1,252 @@ + + +
[-hkt] +[-b BUGURL] [-c CLASSPATH] [-f OUTFILE] [-j JAVAPATH] +[-l TESTLIST ...] [-L NEGLIST ...] [-p TESTPATH] [-s SHELLPATH] + [-u LXRURL] [--help] [--confail] [--trace] [--classpath=CLASSPATH] + [--file=OUTFILE] [--javapath=JAVAPATH] [--list=TESTLIST] + [--neglist=TESTLIST] [--testpath=TESTPATH] [--shellpath=SHELLPATH] + [--lxrurl=LXRURL] {-e ENGINETYPE | --engine=ENGINETYPE} +
perl jsPerformance.pl -e smopt
perl jsPerformance.pl -e smopt -f TEST.html
perl jsDriver.pl -e smopt -l tests/number + Executes all tests +in the tests/number folder against + the optimized Spider Monkey shell.
perl jsDriver.pl -e smopt -l tests/number
tests/number
\n" . + "Test List: $list_name\n" . + "Skip List: $neglist_name\n" . + ($#test_list + 1) . " test(s) selected, " . + "$time_reported timing result(s) reported, $failures_reported failure(s) occurred. \n" . + "Engine command line: $engine_command\n" . + "Configuration: $config\n"); + + if ($opt_engine_type =~ /^rhino/) { + open (JAVAOUTPUT, $opt_java_path . "java -fullversion " . + $redirect_command . " |"); + print OUTPUT ; + print OUTPUT ""; + close (JAVAOUTPUT); + } + + print OUTPUT + ("Testcase execution time: $exec_time_string.\n" . + "Tests completed on $completion_date.\n"); + + if ($time_reported > 0) { + print OUTPUT + ("[ Performance Details | " . + "Test List ]" . + "\n" . + "\n" . + "Performance Details (all times in milliseconds)\n\n" . + "TestMethodTime". + $html . + "\n[ Top of Page | " . + "Top of Tests ]\n" . + "\n" . + "\n" . + "List of Tests Executed\n" . + "". + "# List of Tests Executed, $opt_engine_type, " . + "generated $completion_date.\n" . + "# Original test base was: $list_name.\n" . + "# $tests_completed test(s) selected, ". + "$time_reported timing result(s) reported:\n" . + join ("\n", @performance_tests) . "\n\n". + "# $failures_reported failure(s) reported :\n" . + join ("\n", @failed_tests) . + "\n" . + "[ Top of Page | " . + "Top of Test List ]\n"); + } else { + print OUTPUT + ("Nothing was tested!\n"); + } + + print OUTPUT ""; + + close (OUTPUT); + + &status ("Wrote results to '$opt_output_file'."); + + if ($opt_console_failures) { + &status ("$tests_completed test(s) selected, $time_reported timing result(s) reported."); + &status ("$failures_reported failure(s) reported."); + } +} + +sub parse_args { + my ($option, $value, $lastopt); + + &dd ("checking command line options."); + + Getopt::Mixed::init ($options); + $Getopt::Mixed::order = $Getopt::Mixed::RETURN_IN_ORDER; + + while (($option, $value) = nextOption()) { + + if ($option eq "b") { + &dd ("opt: setting bugurl to '$value'."); + $opt_bug_url = $value; + + } elsif ($option eq "c") { + &dd ("opt: setting classpath to '$value'."); + $opt_classpath = $value; + + } elsif (($option eq "e") || (($option eq "") && ($lastopt eq "e"))) { + &dd ("opt: adding engine $value."); + push (@opt_engine_list, $value); + + } elsif ($option eq "f") { + if (!$value) { + die ("Output file cannot be null.\n"); + } + &dd ("opt: setting output file to '$value'."); + $opt_user_output_file = 1; + $opt_output_file = $value; + + } elsif ($option eq "h") { + &usage; + + } elsif ($option eq "j") { + if (!($value =~ /[\/\\]$/)) { + $value .= "/"; + } + &dd ("opt: setting java path to '$value'."); + $opt_java_path = $value; + + } elsif ($option eq "k") { + &dd ("opt: displaying failures on console."); + $opt_console_failures=1; + + } elsif ($option eq "l" || (($option eq "") && ($lastopt eq "l"))) { + $option = "l"; + &dd ("opt: adding test list '$value'."); + push (@opt_test_list_files, $value); + + } elsif ($option eq "L" || (($option eq "") && ($lastopt eq "L"))) { + $option = "L"; + &dd ("opt: adding negative list '$value'."); + push (@opt_neg_list_files, $value); + + } elsif ($option eq "o") { + $opt_engine_params = $value; + &dd ("opt: setting engine params to '$opt_engine_params'."); + + } elsif ($option eq "p") { + $opt_suite_path = $value; + + if ($os_type eq "MAC") { + if (!($opt_suite_path =~ /\:$/)) { + $opt_suite_path .= ":"; + } + } else { + if (!($opt_suite_path =~ /[\/\\]$/)) { + $opt_suite_path .= "/"; + } + } + + &dd ("opt: setting suite path to '$opt_suite_path'."); + + } elsif ($option eq "s") { + $opt_shell_path = $value; + &dd ("opt: setting shell path to '$opt_shell_path'."); + + } elsif ($option eq "t") { + &dd ("opt: tracing output. (console failures at no extra charge.)"); + $opt_console_failures = 1; + $opt_trace = 1; + + } elsif ($option eq "u") { + &dd ("opt: setting lxr url to '$value'."); + $opt_lxr_url = $value; + + } elsif ($option eq "x") { + &dd ("opt: turning off exit munging."); + $opt_exit_munge = 0; + + } else { + &usage; + } + + $lastopt = $option; + + } + + Getopt::Mixed::cleanup(); + + if ($#opt_engine_list == -1) { + die "You must select a shell to test in.\n"; + } + +} + +# +# print the arguments that this script expects +# +sub usage { + print STDERR + ("\nusage: $0 [] \n" . + "(-b|--bugurl) Bugzilla URL.\n" . + " (default is $opt_bug_url)\n" . + "(-c|--classpath) Classpath (Rhino only.)\n" . + "(-e|--engine) ... Specify the type of engine(s) to test.\n" . + " is one or more of\n" . + " (smopt|smdebug|lcopt|lcdebug|xpcshell|" . + "rhino|rhinoi|rhinoms|rhinomsi|rhino9|rhinoms9).\n" . + "(-f|--file) Redirect output to file named .\n" . + " (default is " . + "results--.html)\n" . + "(-h|--help) Print this message.\n" . + "(-j|--javapath) Location of java executable.\n" . + "(-k|--confail) Log failures to console (also.)\n" . + "(-l|--list) ... List of tests to execute.\n" . + "(-L|--neglist) ... List of tests to skip.\n" . + "(-o|--opt) Options to pass to the JavaScript engine.\n" . + " (Make sure to quote them!)\n" . + "(-p|--testpath) Root of the test suite. (default is ./)\n" . + "(-s|--shellpath) Location of JavaScript shell.\n" . + "(-t|--trace) Trace script execution.\n" . + "(-u|--lxrurl) Complete URL to tests subdirectory on lxr.\n" . + " (default is $opt_lxr_url)\n" . + "(-x|--noexitmunge) Don't do exit code munging (try this if it\n" . + " seems like your exit codes are turning up\n" . + " as exit signals.)\n"); + exit (1); + +} + +# +# get the shell command used to start the (either) engine +# +sub get_engine_command { + + my $retval; + + if ($opt_engine_type eq "rhino") { + &dd ("getting rhino engine command."); + $opt_rhino_opt = 0; + $opt_rhino_ms = 0; + $retval = &get_rhino_engine_command; + } elsif ($opt_engine_type eq "rhinoi") { + &dd ("getting rhinoi engine command."); + $opt_rhino_opt = -1; + $opt_rhino_ms = 0; + $retval = &get_rhino_engine_command; + } elsif ($opt_engine_type eq "rhino9") { + &dd ("getting rhino engine command."); + $opt_rhino_opt = 9; + $opt_rhino_ms = 0; + $retval = &get_rhino_engine_command; + } elsif ($opt_engine_type eq "rhinoms") { + &dd ("getting rhinoms engine command."); + $opt_rhino_opt = 0; + $opt_rhino_ms = 1; + $retval = &get_rhino_engine_command; + } elsif ($opt_engine_type eq "rhinomsi") { + &dd ("getting rhinomsi engine command."); + $opt_rhino_opt = -1; + $opt_rhino_ms = 1; + $retval = &get_rhino_engine_command; + } elsif ($opt_engine_type eq "rhinoms9") { + &dd ("getting rhinomsi engine command."); + $opt_rhino_opt = 9; + $opt_rhino_ms = 1; + $retval = &get_rhino_engine_command; + } elsif ($opt_engine_type eq "xpcshell") { + &dd ("getting xpcshell engine command."); + $retval = &get_xpc_engine_command; + } elsif ($opt_engine_type =~ /^lc(opt|debug)$/) { + &dd ("getting liveconnect engine command."); + $retval = &get_lc_engine_command; + } elsif ($opt_engine_type =~ /^sm(opt|debug)$/) { + &dd ("getting spidermonkey engine command."); + $retval = &get_sm_engine_command; + } elsif ($opt_engine_type =~ /^ep(opt|debug)$/) { + &dd ("getting epimetheus engine command."); + $retval = &get_ep_engine_command; + } else { + die ("Unknown engine type selected, '$opt_engine_type'.\n"); + } + + $retval .= " $opt_engine_params"; + + &dd ("got '$retval'"); + + return $retval; + +} + +# +# get the shell command used to run rhino +# +sub get_rhino_engine_command { + my $retval = $opt_java_path . ($opt_rhino_ms ? "jview " : "java "); + + if ($opt_shell_path) { + $opt_classpath = ($opt_classpath) ? + $opt_classpath . ":" . $opt_shell_path : + $opt_shell_path; + } + + if ($opt_classpath) { + $retval .= ($opt_rhino_ms ? "/cp:p" : "-classpath") . " $opt_classpath "; + } + + $retval .= "org.mozilla.javascript.tools.shell.Main"; + + if ($opt_rhino_opt) { + $retval .= " -opt $opt_rhino_opt"; + } + + return $retval; + +} + +# +# get the shell command used to run xpcshell +# +sub get_xpc_engine_command { + my $retval; + my $m5_home = @ENV{"MOZILLA_FIVE_HOME"} || + die ("You must set MOZILLA_FIVE_HOME to use the xpcshell" , + (!$unixish) ? "." : ", also " . + "setting LD_LIBRARY_PATH to the same directory may get rid of " . + "any 'library not found' errors.\n"); + + if (($unixish) && (!@ENV{"LD_LIBRARY_PATH"})) { + print STDERR "-#- WARNING: LD_LIBRARY_PATH is not set, xpcshell may " . + "not be able to find the required components.\n"; + } + + if (!($m5_home =~ /[\/\\]$/)) { + $m5_home .= "/"; + } + + $retval = $m5_home . "xpcshell"; + + if ($os_type eq "WIN") { + $retval .= ".exe"; + } + + $retval = &xp_path($retval); + + if (($os_type ne "MAC") && !(-x $retval)) { + # mac doesn't seem to deal with -x correctly + die ($retval . " is not a valid executable on this system.\n"); + } + + return $retval; + +} + +# +# get the shell command used to run spidermonkey +# +sub get_sm_engine_command { + my $retval; + + # Look for Makefile.ref style make first. + # (On Windows, spidermonkey can be made by two makefiles, each putting the + # executable in a diferent directory, under a different name.) + + if ($opt_shell_path) { + # if the user provided a path to the shell, return that. + $retval = $opt_shell_path; + + } else { + + if ($os_type eq "MAC") { + $retval = $opt_suite_path . ":src:macbuild:JS"; + } else { + $retval = $opt_suite_path . "../src/"; + opendir (SRC_DIR_FILES, $retval); + my @src_dir_files = readdir(SRC_DIR_FILES); + closedir (SRC_DIR_FILES); + + my ($dir, $object_dir); + my $pattern = ($opt_engine_type eq "smdebug") ? + 'DBG.OBJ' : 'OPT.OBJ'; + + # scan for the first directory matching + # the pattern expected to hold this type (debug or opt) of engine + foreach $dir (@src_dir_files) { + if ($dir =~ $pattern) { + $object_dir = $dir; + last; + } + } + + if (!$object_dir && $os_type ne "WIN") { + die ("Could not locate an object directory in $retval " . + "matching the pattern *$pattern. Have you built the " . + "engine?\n"); + } + + if (!(-x $retval . $object_dir . "/js.exe") && ($os_type eq "WIN")) { + # On windows, you can build with js.mak as well as Makefile.ref + # (Can you say WTF boys and girls? I knew you could.) + # So, if the exe the would have been built by Makefile.ref isn't + # here, check for the js.mak version before dying. + if ($opt_shell_path) { + $retval = $opt_shell_path; + if (!($retval =~ /[\/\\]$/)) { + $retval .= "/"; + } + } else { + if ($opt_engine_type eq "smopt") { + $retval = "../src/Release/"; + } else { + $retval = "../src/Debug/"; + } + } + + $retval .= "jsshell.exe"; + + } else { + $retval .= $object_dir . "/js"; + if ($os_type eq "WIN") { + $retval .= ".exe"; + } + } + } # mac/ not mac + + $retval = &xp_path($retval); + + } # (user provided a path) + + + if (($os_type ne "MAC") && !(-x $retval)) { + # mac doesn't seem to deal with -x correctly + die ($retval . " is not a valid executable on this system.\n"); + } + + return $retval; + +} + +# +# get the shell command used to run epimetheus +# +sub get_ep_engine_command { + my $retval; + + if ($opt_shell_path) { + # if the user provided a path to the shell, return that - + $retval = $opt_shell_path; + + } else { + my $dir; + my $os; + my $debug; + my $opt; + my $exe; + + $dir = $opt_suite_path . "../../js2/src/"; + + if ($os_type eq "MAC") { + # + # On the Mac, the debug and opt builds lie in the same directory - + # + $os = "macbuild:"; + $debug = ""; + $opt = ""; + $exe = "JS2"; + } elsif ($os_type eq "WIN") { + $os = "winbuild/Epimetheus/"; + $debug = "Debug/"; + $opt = "Release/"; + $exe = "Epimetheus.exe"; + } else { + $os = ""; + $debug = ""; + $opt = ""; # <<<----- XXX THIS IS NOT RIGHT! CHANGE IT! + $exe = "epimetheus"; + } + + + if ($opt_engine_type eq "epdebug") { + $retval = $dir . $os . $debug . $exe; + } else { + $retval = $dir . $os . $opt . $exe; + } + + $retval = &xp_path($retval); + + }# (user provided a path) + + + if (($os_type ne "MAC") && !(-x $retval)) { + # mac doesn't seem to deal with -x correctly + die ($retval . " is not a valid executable on this system.\n"); + } + + return $retval; +} + +# +# get the shell command used to run the liveconnect shell +# +sub get_lc_engine_command { + my $retval; + + if ($opt_shell_path) { + $retval = $opt_shell_path; + } else { + if ($os_type eq "MAC") { + die "Don't know how to run the lc shell on the mac yet.\n"; + } else { + $retval = $opt_suite_path . "../src/liveconnect/"; + opendir (SRC_DIR_FILES, $retval); + my @src_dir_files = readdir(SRC_DIR_FILES); + closedir (SRC_DIR_FILES); + + my ($dir, $object_dir); + my $pattern = ($opt_engine_type eq "lcdebug") ? + 'DBG.OBJ' : 'OPT.OBJ'; + + foreach $dir (@src_dir_files) { + if ($dir =~ $pattern) { + $object_dir = $dir; + last; + } + } + + if (!$object_dir) { + die ("Could not locate an object directory in $retval " . + "matching the pattern *$pattern. Have you built the " . + "engine?\n"); + } + + $retval .= $object_dir . "/"; + + if ($os_type eq "WIN") { + $retval .= "lcshell.exe"; + } else { + $retval .= "lcshell"; + } + } # mac/ not mac + + $retval = &xp_path($retval); + + } # (user provided a path) + + + if (($os_type ne "MAC") && !(-x $retval)) { + # mac doesn't seem to deal with -x correctly + die ("$retval is not a valid executable on this system.\n"); + } + + return $retval; + +} + +sub get_os_type { + + if ("\n" eq "\015") { + return "MAC"; + } + + my $uname = `uname -a`; + + if ($uname =~ /WIN/) { + $uname = "WIN"; + } else { + chop $uname; + } + + &dd ("get_os_type returning '$uname'."); + return $uname; + +} + +sub get_test_list { + my @test_list; + my @neg_list; + + if ($#opt_test_list_files > -1) { + my $list_file; + + &dd ("getting test list from user specified source."); + + foreach $list_file (@opt_test_list_files) { + push (@test_list, &expand_user_test_list($list_file)); + } + } else { + &dd ("no list file, groveling in '$opt_suite_path'."); + + @test_list = &get_default_test_list($opt_suite_path); + } + + if ($#opt_neg_list_files > -1) { + my $list_file; + my $orig_size = $#test_list + 1; + my $actually_skipped; + + &dd ("getting negative list from user specified source."); + + foreach $list_file (@opt_neg_list_files) { + push (@neg_list, &expand_user_test_list($list_file)); + } + + @test_list = &subtract_arrays (\@test_list, \@neg_list); + + $actually_skipped = $orig_size - ($#test_list + 1); + + &dd ($actually_skipped . " of " . $orig_size . + " tests will be skipped."); + &dd ((($#neg_list + 1) - $actually_skipped) . " skip tests were " . + "not actually part of the test list."); + + + } + + return @test_list; + +} + +# +# reads $list_file, storing non-comment lines into an array. +# lines in the form suite_dir/[*] or suite_dir/test_dir/[*] are expanded +# to include all test files under the specified directory +# +sub expand_user_test_list { + my ($list_file) = @_; + my @retval = (); + + # + # Trim off the leading path separator that begins relative paths on the Mac. + # Each path will get concatenated with $opt_suite_path, which ends in one. + # + # Also note: + # + # We will call expand_test_list_entry(), which does pattern-matching on $list_file. + # This will make the pattern-matching the same as it would be on Linux/Windows - + # + if ($os_type eq "MAC") { + $list_file =~ s/^$path_sep//; + } + + if ($list_file =~ /\.js$/ || -d $opt_suite_path . $list_file) { + + push (@retval, &expand_test_list_entry($list_file)); + + } else { + + open (TESTLIST, $list_file) || + die("Error opening test list file '$list_file': $!\n"); + + while () { + s/\r*\n*$//; + if (!(/\s*\#/)) { + # It's not a comment, so process it + push (@retval, &expand_test_list_entry($_)); + } + } + + close (TESTLIST); + + } + + return @retval; + +} + + +# +# Currently expect all paths to be RELATIVE to the top-level tests directory. +# One day, this should be improved to allow absolute paths as well - +# +sub expand_test_list_entry { + my ($entry) = @_; + my @retval; + + if ($entry =~ /\.js$/) { + # it's a regular entry, add it to the list + if (-f $opt_suite_path . $entry) { + push (@retval, $entry); + } else { + status ("testcase '$entry' not found."); + } + } elsif ($entry =~ /(.*$path_sep[^\*][^$path_sep]*)$path_sep?\*?$/) { + # Entry is in the form suite_dir/test_dir[/*] + # so iterate all tests under it + my $suite_and_test_dir = $1; + my @test_files = &get_js_files ($opt_suite_path . + $suite_and_test_dir); + my $i; + + foreach $i (0 .. $#test_files) { + $test_files[$i] = $suite_and_test_dir . $path_sep . + $test_files[$i]; + } + + splice (@retval, $#retval + 1, 0, @test_files); + + } elsif ($entry =~ /([^\*][^$path_sep]*)$path_sep?\*?$/) { + # Entry is in the form suite_dir[/*] + # so iterate all test dirs and tests under it + my $suite = $1; + my @test_dirs = &get_subdirs ($opt_suite_path . $suite); + my $test_dir; + + foreach $test_dir (@test_dirs) { + my @test_files = &get_js_files ($opt_suite_path . $suite . + $path_sep . $test_dir); + my $i; + + foreach $i (0 .. $#test_files) { + $test_files[$i] = $suite . $path_sep . $test_dir . $path_sep . + $test_files[$i]; + } + + splice (@retval, $#retval + 1, 0, @test_files); + } + + } else { + die ("Dont know what to do with list entry '$entry'.\n"); + } + + return @retval; + +} + +# +# Grovels through $suite_path, searching for *all* test files. Used when the +# user doesn't supply a test list. +# +sub get_default_test_list { + my ($suite_path) = @_; + my @suite_list = &get_subdirs($suite_path); + my $suite; + my @retval; + + foreach $suite (@suite_list) { + my @test_dir_list = get_subdirs ($suite_path . $suite); + my $test_dir; + + foreach $test_dir (@test_dir_list) { + my @test_list = get_js_files ($suite_path . $suite . $path_sep . + $test_dir); + my $test; + + foreach $test (@test_list) { + $retval[$#retval + 1] = $suite . $path_sep . $test_dir . + $path_sep . $test; + } + } + } + + return @retval; + +} + +# +# generate an output file name based on the date +# +sub get_tempfile_name { + my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = + &get_padded_time (localtime); + my $rv; + + if ($os_type ne "MAC") { + $rv = "results-" . $year . "-" . $mon . "-" . $mday . "-" . $hour . + $min . $sec . "-" . $opt_engine_type; + } else { + $rv = "res-" . $year . $mon . $mday . $hour . $min . $sec . "-" . + $opt_engine_type + } + + return $rv . ".html"; +} + +sub get_padded_time { + my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = @_; + + $mon++; + $mon = &zero_pad($mon); + $year += 1900; + $mday= &zero_pad($mday); + $sec = &zero_pad($sec); + $min = &zero_pad($min); + $hour = &zero_pad($hour); + + return ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst); + +} + +sub zero_pad { + my ($string) = @_; + + $string = ($string < 10) ? "0" . $string : $string; + return $string; +} + +sub subtract_arrays { + my ($whole_ref, $part_ref) = @_; + my @whole = @$whole_ref; + my @part = @$part_ref; + my $line; + + foreach $line (@part) { + @whole = grep (!/$line/, @whole); + } + + return @whole; + +} + +# +# Convert unix path to mac style. +# +sub unix_to_mac { + my ($path) = @_; + my @path_elements = split ("/", $path); + my $rv = ""; + my $i; + + foreach $i (0 .. $#path_elements) { + if ($path_elements[$i] eq ".") { + if (!($rv =~ /\:$/)) { + $rv .= ":"; + } + } elsif ($path_elements[$i] eq "..") { + if (!($rv =~ /\:$/)) { + $rv .= "::"; + } else { + $rv .= ":"; + } + } elsif ($path_elements[$i] ne "") { + $rv .= $path_elements[$i] . ":"; + } + + } + + $rv =~ s/\:$//; + + return $rv; +} + +# +# Convert unix path to win style. +# +sub unix_to_win { + my ($path) = @_; + + if ($path_sep ne $win_sep) { + $path =~ s/$path_sep/$win_sep/g; + } + + return $path; +} + +# +# Windows shells require "/" or "\" as path separator. +# Find out the one used in the current Windows shell. +# +sub get_win_sep { + my $path = $ENV{"PATH"} || $ENV{"Path"} || $ENV{"path"}; + $path =~ /\\|\//; + return $&; +} + +# +# Convert unix path to correct style based on platform. +# +sub xp_path { + my ($path) = @_; + + if ($os_type eq "MAC") { + return &unix_to_mac($path); + } elsif($os_type eq "WIN") { + return &unix_to_win($path); + } else { + return $path; + } +} + +# +# given a directory, return an array of all subdirectories +# +sub get_subdirs { + my ($dir) = @_; + my @subdirs; + + if ($os_type ne "MAC") { + if (!($dir =~ /\/$/)) { + $dir = $dir . "/"; + } + } else { + if (!($dir =~ /\:$/)) { + $dir = $dir . ":"; + } + } + opendir (DIR, $dir) || die ("couldn't open directory $dir: $!"); + my @testdir_contents = readdir(DIR); + closedir(DIR); + + foreach (@testdir_contents) { + if ((-d ($dir . $_)) && ($_ ne 'CVS') && ($_ ne '.') && ($_ ne '..')) { + @subdirs[$#subdirs + 1] = $_; + } + } + + return @subdirs; +} + +# +# given a directory, return an array of all the js files that are in it. +# +sub get_js_files { + my ($test_subdir) = @_; + my (@js_file_array, @subdir_files); + + opendir (TEST_SUBDIR, $test_subdir) || die ("couldn't open directory " . + "$test_subdir: $!"); + @subdir_files = readdir(TEST_SUBDIR); + closedir( TEST_SUBDIR ); + + foreach (@subdir_files) { + if ($_ =~ /\.js$/) { + $js_file_array[$#js_file_array+1] = $_; + } + } + + return @js_file_array; +} + +sub report_failure { + my ($test, $message, $bug_number) = @_; + my $bug_line = ""; + + $failures_reported++; + + $message =~ s/\n+/\n/g; + $test =~ s/\:/\//g; + + if ($opt_console_failures) { + if($bug_number) { + print STDERR ("*-* Testcase $test failed:\nBug Number $bug_number". + "\n$message\n"); + } else { + print STDERR ("*-* Testcase $test failed:\n$message\n"); + } + } + + $message =~ s/\n/\n/g; + $html .= ""; + + if ($bug_number) { + $bug_line = "". + "Bug Number $bug_number"; + } + + if ($opt_lxr_url) { + $test =~ /\/?([^\/]+\/[^\/]+\/[^\/]+)$/; + $test = $1; + $html .= "". + "Testcase $1 " . + "failed $bug_line\n"; + } else { + $html .= "". + "Testcase $test failed $bug_line\n"; + } + + $html .= " [ "; + if ($failures_reported > 1) { + $html .= "" . + "Previous Failure | "; + } + + $html .= "" . + "Next Failure | " . + "Top of Page ]\n" . + "$message\n"; + + @failed_tests[$#failed_tests + 1] = $test; + +} + +sub report_test { + my ($test, $message, $bug_number, $time_message) = @_; + my $bug_line = ""; + + $message =~ s/\n+/\n/g; + $test =~ s/\:/\//g; + + if ($opt_console_failures) { + if($bug_number) { + print STDERR ("\n*-* Testcase $test:\nBug Number $bug_number". + "\n$time_message\n"); + } else { + print STDERR ("\n*-* Testcase $test:\n$time_message\n\n"); + } + } + + $html .= "$message"; + + @performance_tests[$#performance_tests + 1] = $test; +} + + +sub send_results_to_server { + my ($methodtime, $method, $test, $config) = @_; + + my $tmpurl = $server; + $tmpurl .= "?value=$methodtime&data=$method&testname=$method&tbox=$config"; + print STDERR "send_results_to_server(): \n"; + print STDERR "tmpurl = $tmpurl\n"; + + my $res = eval q{ + use LWP::UserAgent; + use HTTP::Request; + my $ua = LWP::UserAgent->new; + $ua->timeout(10); # seconds + my $req = HTTP::Request->new(GET => $tmpurl); + my $res = $ua->request($req); + return $res; + }; + if ($@) { + warn "Failed to submit startup results: $@"; + print STDERR "send_results_to_server() failed.\n"; + } else { + print "Results submitted to server: \n", + $res->status_line, "\n", $res->content, "\n"; + print STDERR "send_results_to_server() succeeded.\n"; + } + +} + +sub read_config_file{ + my($myconfig) = shift; + my $machineconfig; + + if (-f "config.txt") + { + open( CONFIGFILE, " ) { + $_ =~ s/#.*//; # ignore comments by erasing them + next if $_ =~ /^(\s)*$/; # skip blank lines + chomp; # remove trailing newline characters + $machineconfig = $_; # push the data line onto the array + last; + } + close CONFIGFILE; + return $machineconfig; +} + +sub dd { + + if ($opt_trace) { + print ("-*- ", @_ , "\n"); + } + +} + +sub status { + + print ("-#- ", @_ , "\n"); + +} + +sub int_handler { + my $resp; + + do { + print ("\n*** User Break: Just [Q]uit, Quit and [R]eport, [C]ontinue ?"); + $resp = ; + } until ($resp =~ /[QqRrCc]/); + + if ($resp =~ /[Qq]/) { + print ("User Exit. No results were generated.\n"); + exit; + } elsif ($resp =~ /[Rr]/) { + $user_exit = 1; + } + +}
". + "# List of Tests Executed, $opt_engine_type, " . + "generated $completion_date.\n" . + "# Original test base was: $list_name.\n" . + "# $tests_completed test(s) selected, ". + "$time_reported timing result(s) reported:\n" . + join ("\n", @performance_tests) . "\n\n". + "# $failures_reported failure(s) reported :\n" . + join ("\n", @failed_tests) . + "