mirror of
https://gitlab.winehq.org/wine/wine-gecko.git
synced 2024-09-13 09:24:08 -07:00
1598 lines
47 KiB
Perl
Executable File
1598 lines
47 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
# -*- Mode: Perl; tab-width: 4; indent-tabs-mode: nil; -*-
|
|
# vim: set ts=4 sw=4 et tw=80:
|
|
# ***** BEGIN LICENSE BLOCK *****
|
|
# Version: MPL 1.1/GPL 2.0/LGPL 2.1
|
|
#
|
|
# The contents of this file are subject to the Mozilla Public License Version
|
|
# 1.1 (the "License"); you may not use this file except in compliance with
|
|
# the License. You may obtain a copy of the License at
|
|
# http://www.mozilla.org/MPL/
|
|
#
|
|
# Software distributed under the License is distributed on an "AS IS" basis,
|
|
# WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
|
|
# for the specific language governing rights and limitations under the
|
|
# License.
|
|
#
|
|
# The Original Code is JavaScript Core Tests.
|
|
#
|
|
# The Initial Developer of the Original Code is
|
|
# Netscape Communications Corporation.
|
|
# Portions created by the Initial Developer are Copyright (C) 1997-1999
|
|
# the Initial Developer. All Rights Reserved.
|
|
#
|
|
# Contributor(s):
|
|
# Robert Ginda <rginda@netscape.com>
|
|
#
|
|
# Alternatively, the contents of this file may be used under the terms of
|
|
# either the GNU General Public License Version 2 or later (the "GPL"), or
|
|
# the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
|
|
# in which case the provisions of the GPL or the LGPL are applicable instead
|
|
# of those above. If you wish to allow use of your version of this file only
|
|
# under the terms of either the GPL or the LGPL, and not to allow others to
|
|
# use your version of this file under the terms of the MPL, indicate your
|
|
# decision by deleting the provisions above and replace them with the notice
|
|
# and other provisions required by the GPL or the LGPL. If you do not delete
|
|
# the provisions above, a recipient may use your version of this file under
|
|
# the terms of any one of the MPL, the GPL or the LGPL.
|
|
#
|
|
# ***** END LICENSE BLOCK *****
|
|
|
|
# Second cut at runtests.pl script originally by
|
|
# Christine Begle (cbegle@netscape.com)
|
|
# Branched 11/01/99
|
|
|
|
use strict;
|
|
use File::Temp qw/ tempfile tempdir /;
|
|
use POSIX qw(sys_wait_h);
|
|
|
|
my $os_type = &get_os_type;
|
|
my $unixish = (($os_type ne "WIN") && ($os_type ne "MAC"));
|
|
my $path_sep = ($os_type eq "MAC") ? ":" : "/";
|
|
my $win_sep = ($os_type eq "WIN")? &get_win_sep : "";
|
|
my $redirect_command = ($os_type ne "MAC") ? " 2>&1" : "";
|
|
|
|
# command line option defaults
|
|
my $opt_suite_path;
|
|
my $opt_trace = 0;
|
|
my $opt_classpath = "";
|
|
my $opt_rhino_opt = 0;
|
|
my $opt_rhino_ms = 0;
|
|
my @opt_engine_list;
|
|
my $opt_engine_type = "";
|
|
my $opt_engine_params = "";
|
|
my $opt_user_output_file = 0;
|
|
my $opt_output_file = "";
|
|
my @opt_test_list_files;
|
|
my @opt_neg_list_files;
|
|
my $opt_shell_path = "";
|
|
my $opt_java_path = "";
|
|
my $opt_bug_url = "https://bugzilla.mozilla.org/show_bug.cgi?id=";
|
|
my $opt_console_failures = 0;
|
|
my $opt_console_failures_line = 0;
|
|
my $opt_lxr_url = "http://lxr.mozilla.org/mozilla/source/js/tests/";
|
|
my $opt_exit_munge = ($os_type ne "MAC") ? 1 : 0;
|
|
my $opt_timeout = 3600;
|
|
my $opt_enable_narcissus = 0;
|
|
my $opt_narcissus_path = "";
|
|
my $opt_no_quit = 0;
|
|
my $opt_report_summarized_results = 0;
|
|
|
|
# command line option definition
|
|
my $options = "b=s bugurl>b c=s classpath>c e=s engine>e f=s file>f " .
|
|
"h help>h i j=s javapath>j k confail>k K linefail>K R report>R l=s list>l " .
|
|
"L=s neglist>L o=s opt>o p=s testpath>p s=s shellpath>s t trace>t " .
|
|
"T=s timeout>T u=s lxrurl>u " .
|
|
"x noexitmunge>x n=s narcissus>n " .
|
|
"Q noquitinthandler>Q";
|
|
|
|
my $last_option;
|
|
|
|
if ($os_type eq "MAC") {
|
|
$opt_suite_path = `directory`;
|
|
$opt_suite_path =~ s/[\n\r]//g;
|
|
$opt_suite_path .= ":";
|
|
} else {
|
|
$opt_suite_path = "./";
|
|
}
|
|
|
|
&parse_args;
|
|
|
|
my $user_exit = 0;
|
|
my ($engine_command, $html, $failures_reported, $tests_completed,
|
|
$exec_time_string);
|
|
my @failed_tests;
|
|
my @test_list = &get_test_list;
|
|
|
|
if ($#test_list == -1) {
|
|
die ("Nothing to test.\n");
|
|
}
|
|
|
|
if ($unixish && $opt_no_quit == 0) {
|
|
# on unix, ^C pauses the tests, and gives the user a chance to quit but
|
|
# report on what has been done, to just quit, or to continue (the
|
|
# interrupted test will still be skipped.)
|
|
# windows doesn't handle the int handler they way we want it to,
|
|
# so don't even pretend to let the user continue.
|
|
$SIG{INT} = 'int_handler';
|
|
}
|
|
|
|
my $current_test;
|
|
my $current_test_pid;
|
|
|
|
&main;
|
|
|
|
#End.
|
|
|
|
sub main {
|
|
my $start_time;
|
|
|
|
while ($opt_engine_type = pop (@opt_engine_list)) {
|
|
dd ("Testing engine '$opt_engine_type'");
|
|
|
|
$engine_command = &get_engine_command;
|
|
$html = "";
|
|
@failed_tests = ();
|
|
$failures_reported = 0;
|
|
$tests_completed = 0;
|
|
$start_time = time;
|
|
|
|
|
|
&execute_tests (@test_list);
|
|
|
|
my $exec_time = (time - $start_time);
|
|
my $exec_hours = int($exec_time / 60 / 60);
|
|
$exec_time -= $exec_hours * 60 * 60;
|
|
my $exec_mins = int($exec_time / 60);
|
|
$exec_time -= $exec_mins * 60;
|
|
my $exec_secs = ($exec_time % 60);
|
|
|
|
if ($exec_hours > 0) {
|
|
$exec_time_string = "$exec_hours hours, $exec_mins minutes, " .
|
|
"$exec_secs seconds";
|
|
} elsif ($exec_mins > 0) {
|
|
$exec_time_string = "$exec_mins minutes, $exec_secs seconds";
|
|
} else {
|
|
$exec_time_string = "$exec_secs seconds";
|
|
}
|
|
|
|
if (!$opt_user_output_file) {
|
|
$opt_output_file = &get_tempfile_name;
|
|
}
|
|
|
|
&write_results;
|
|
|
|
}
|
|
}
|
|
|
|
sub append_file_to_command {
|
|
my ($command, $file) = @_;
|
|
|
|
if ($opt_enable_narcissus == 1) {
|
|
$command .= " -e 'evaluate(\"load(\\\"$file\\\")\")'"
|
|
} else {
|
|
$command .= " -f $file";
|
|
}
|
|
}
|
|
|
|
sub execute_tests {
|
|
my (@test_list) = @_;
|
|
my ($test, $shell_command, $line, @output, $path);
|
|
my ($last_suite, $last_test_dir);
|
|
|
|
&status ("Executing " . ($#test_list + 1) . " test(s).");
|
|
|
|
foreach $test (@test_list) {
|
|
my ($suite, $test_dir, $test_file) = split($path_sep, $test);
|
|
# *-n.js is a negative test, expect exit code 3 (runtime error)
|
|
my $expected_exit = ($test =~ /\-n\.js$/) ? 3 : 0;
|
|
my ($got_exit, $exit_signal);
|
|
my $failure_lines;
|
|
my $bug_number;
|
|
my $status_lines;
|
|
my $result_lines;
|
|
|
|
# Allow the test to declare multiple possible success exit codes.
|
|
# This is useful in situations where the test fails if a
|
|
# crash occurs but passes if no crash occurs even if an
|
|
# out of memory error occurs.
|
|
my @expected_exit_list = ($expected_exit);
|
|
|
|
# user selected [Q]uit from ^C handler.
|
|
if ($user_exit) {
|
|
return;
|
|
}
|
|
|
|
$current_test = $test;
|
|
|
|
# Append the shell.js files to the shell_command if they're there.
|
|
# (only check for their existance if the suite or test_dir has changed
|
|
# since the last time we looked.)
|
|
if ($last_suite ne $suite || $last_test_dir ne $test_dir) {
|
|
$shell_command = &xp_path($engine_command);
|
|
|
|
$path = &xp_path($opt_suite_path ."shell.js");
|
|
if (-f $path) {
|
|
$shell_command = &append_file_to_command($shell_command,
|
|
$path);
|
|
}
|
|
|
|
$path = &xp_path($opt_suite_path . $suite . "/shell.js");
|
|
if (-f $path) {
|
|
$shell_command = &append_file_to_command($shell_command,
|
|
$path);
|
|
}
|
|
|
|
$path = &xp_path($opt_suite_path . $suite . "/" .
|
|
$test_dir . "/shell.js");
|
|
if (-f $path) {
|
|
$shell_command = &append_file_to_command($shell_command,
|
|
$path);
|
|
}
|
|
|
|
$last_suite = $suite;
|
|
$last_test_dir = $test_dir;
|
|
}
|
|
|
|
$path = &xp_path($opt_suite_path . $test);
|
|
my $command = &append_file_to_command($shell_command, $path);
|
|
|
|
$path = &xp_path($opt_suite_path ."js-test-driver-end.js");
|
|
if (-f $path) {
|
|
$command = &append_file_to_command($command,
|
|
$path);
|
|
}
|
|
|
|
&dd ("executing: " . $command);
|
|
|
|
my $jsout;
|
|
(undef, $jsout) = tempfile();
|
|
|
|
#XXX cloned from tinderbox. See sub kill_process
|
|
my $pid = fork; # Fork a child process to run the test
|
|
unless ($pid) {
|
|
open STDOUT, ">$jsout";
|
|
open STDERR, ">&STDOUT";
|
|
select STDOUT; $| = 1; # make STDOUT unbuffered
|
|
select STDERR; $| = 1; # make STDERR unbuffered
|
|
exec $command;
|
|
die "Could not exec $command";
|
|
}
|
|
|
|
$current_test_pid = $pid;
|
|
|
|
my $timed_out = 0;
|
|
my $dumped_core = 0;
|
|
my $loop_count = 0;
|
|
my $wait_pid = -1;
|
|
|
|
eval
|
|
{
|
|
local $SIG{ALRM} = sub { die "time out" };
|
|
alarm $opt_timeout;
|
|
$wait_pid = waitpid($pid, 0);
|
|
alarm 0;
|
|
};
|
|
|
|
if ($@ and $@ =~ /time out/)
|
|
{
|
|
kill_process($pid);
|
|
$timed_out = 1;
|
|
}
|
|
|
|
$current_test_pid = undef;
|
|
|
|
if ($opt_exit_munge == 1) {
|
|
# signal information in the lower 8 bits, exit code above that
|
|
$got_exit = ($? >> 8);
|
|
$exit_signal = ($? & 255);
|
|
} else {
|
|
# user says not to munge the exit code
|
|
$got_exit = $?;
|
|
$exit_signal = 0;
|
|
}
|
|
|
|
open (OUTPUT, "$jsout") or
|
|
die "failed to open temporary file $jsout: $!\n";
|
|
@output = <OUTPUT>;
|
|
close (OUTPUT);
|
|
unlink "$jsout";
|
|
@output = grep (!/js\>/, @output);
|
|
|
|
$failure_lines = "";
|
|
$bug_number = "";
|
|
$status_lines = "";
|
|
$result_lines = "";
|
|
|
|
foreach $line (@output) {
|
|
|
|
# watch for testcase to proclaim what exit code it expects to
|
|
# produce (0 by default)
|
|
if ($line =~ /expect(ed)?\s*exit\s*code\s*\:?\s*(\d+)/i) {
|
|
$expected_exit = $2;
|
|
push @expected_exit_list, ($expected_exit);
|
|
&dd ("Test case expects exit code $expected_exit");
|
|
}
|
|
|
|
# watch for failures
|
|
if ($line =~ /^\s*FAILED!/) {
|
|
$failure_lines .= $line;
|
|
}
|
|
|
|
# and watch for bugnumbers
|
|
# XXX This only allows 1 bugnumber per testfile, should be
|
|
# XXX modified to allow for multiple.
|
|
if ($line =~ /bugnumber\s*\:?\s*(.*)/i) {
|
|
my $bugline = $1;
|
|
$bugline =~ /(\d+)/;
|
|
$bug_number = $1;
|
|
}
|
|
|
|
# and watch for status
|
|
if ($line =~ /status/i) {
|
|
$status_lines .= $line;
|
|
}
|
|
|
|
# collect result summary lines
|
|
if ($line =~ /^jstest:/)
|
|
{
|
|
$result_lines .= $line;
|
|
}
|
|
}
|
|
|
|
if (!@output) {
|
|
@output = ("Testcase produced no output!");
|
|
}
|
|
|
|
if ($opt_report_summarized_results) {
|
|
print STDERR $result_lines;
|
|
if ($timed_out)
|
|
{
|
|
&report_summary_result($test, $bug_number, "FAILED TIMED OUT",
|
|
"", "", "",
|
|
join("\n",@output));
|
|
}
|
|
elsif (index(join(',', @expected_exit_list), $got_exit) == -1 ||
|
|
$exit_signal != 0) {
|
|
&report_summary_result($test, $bug_number, "FAILED",
|
|
"",
|
|
"Expected exit $expected_exit",
|
|
"Actual exit $got_exit, signal $exit_signal",
|
|
join("\n",@output));
|
|
}
|
|
elsif ($got_exit != 0) {
|
|
# abnormal termination but the test passed, so output a summary line
|
|
&report_summary_result($test, $bug_number, "PASSED",
|
|
"",
|
|
"Expected exit $expected_exit",
|
|
"Actual exit $got_exit, signal $exit_signal",
|
|
join("\n",@output));
|
|
}
|
|
}
|
|
elsif ($timed_out) {
|
|
# test was terminated due to timeout
|
|
&report_failure ($test, "TIMED OUT ($opt_timeout seconds) " .
|
|
"Complete testcase output was:\n" .
|
|
join ("\n",@output), $bug_number);
|
|
}
|
|
elsif (index(join(',', @expected_exit_list), $got_exit) == -1 ||
|
|
$exit_signal != 0) {
|
|
# full testcase output dumped on mismatched exit codes,
|
|
&report_failure ($test, "Expected exit code " .
|
|
"$expected_exit, got $got_exit\n" .
|
|
"Testcase terminated with signal $exit_signal\n" .
|
|
"Complete testcase output was:\n" .
|
|
join ("\n",@output), $bug_number);
|
|
} elsif ($failure_lines) {
|
|
# only offending lines if exit codes matched
|
|
&report_failure ($test, "$status_lines\n".
|
|
"Failure messages were:\n$failure_lines",
|
|
$bug_number);
|
|
}
|
|
|
|
&dd ("exit code $got_exit, exit signal $exit_signal.");
|
|
|
|
$tests_completed++;
|
|
}
|
|
}
|
|
|
|
sub write_results {
|
|
my ($list_name, $neglist_name);
|
|
my $completion_date = localtime;
|
|
my $failure_pct = int(($failures_reported / $tests_completed) * 10000) /
|
|
100;
|
|
&dd ("Writing output to $opt_output_file.");
|
|
|
|
if ($#opt_test_list_files == -1) {
|
|
$list_name = "All tests";
|
|
} elsif ($#opt_test_list_files < 10) {
|
|
$list_name = join (", ", @opt_test_list_files);
|
|
} else {
|
|
$list_name = "($#opt_test_list_files test files specified)";
|
|
}
|
|
|
|
if ($#opt_neg_list_files == -1) {
|
|
$neglist_name = "(none)";
|
|
} elsif ($#opt_test_list_files < 10) {
|
|
$neglist_name = join (", ", @opt_neg_list_files);
|
|
} else {
|
|
$neglist_name = "($#opt_neg_list_files skip files specified)";
|
|
}
|
|
|
|
open (OUTPUT, "> $opt_output_file") ||
|
|
die ("Could not create output file $opt_output_file");
|
|
|
|
print OUTPUT
|
|
("<html><head>\n" .
|
|
"<title>Test results, $opt_engine_type</title>\n" .
|
|
"</head>\n" .
|
|
"<body bgcolor='white'>\n" .
|
|
"<a name='tippy_top'></a>\n" .
|
|
"<h2>Test results, $opt_engine_type</h2><br>\n" .
|
|
"<p class='results_summary'>\n" .
|
|
"Test List: $list_name<br>\n" .
|
|
"Skip List: $neglist_name<br>\n" .
|
|
($#test_list + 1) . " test(s) selected, $tests_completed test(s) " .
|
|
"completed, $failures_reported failures reported " .
|
|
"($failure_pct% failed)<br>\n" .
|
|
"Engine command line: $engine_command<br>\n" .
|
|
"OS type: $os_type<br>\n");
|
|
|
|
if ($opt_engine_type =~ /^rhino/) {
|
|
open (JAVAOUTPUT, $opt_java_path . "java -fullversion " .
|
|
$redirect_command . " |");
|
|
print OUTPUT <JAVAOUTPUT>;
|
|
print OUTPUT "<BR>";
|
|
close (JAVAOUTPUT);
|
|
}
|
|
|
|
print OUTPUT
|
|
("Testcase execution time: $exec_time_string.<br>\n" .
|
|
"Tests completed on $completion_date.<br><br>\n");
|
|
|
|
if ($failures_reported > 0) {
|
|
my $output_file_failures = $opt_output_file;
|
|
$output_file_failures =~ s/(.*)\.html$/$1-failures.txt/;
|
|
open (OUTPUTFAILURES, "> $output_file_failures") ||
|
|
die ("Could not create failure output file $output_file_failures");
|
|
print OUTPUTFAILURES (join ("\n", @failed_tests));
|
|
print OUTPUTFAILURES "\n";
|
|
close OUTPUTFAILURES;
|
|
|
|
&status ("Wrote failures to '$output_file_failures'.");
|
|
|
|
print OUTPUT
|
|
("[ <a href='#fail_detail'>Failure Details</a> | " .
|
|
"<a href='#retest_list'>Retest List</a> | " .
|
|
"<a href='$opt_lxr_url" . "menu.html'>Test Selection Page</a> ]<br>\n" .
|
|
"<hr>\n" .
|
|
"<a name='fail_detail'></a>\n" .
|
|
"<h2>Failure Details</h2><br>\n<dl>" .
|
|
$html .
|
|
"</dl>\n[ <a href='#tippy_top'>Top of Page</a> | " .
|
|
"<a href='#fail_detail'>Top of Failures</a> ]<br>\n" .
|
|
"<hr>\n" .
|
|
"<a name='retest_list'></a>\n" .
|
|
"<h2>Retest List</h2><br>\n" .
|
|
"<pre>\n" .
|
|
"# Retest List, $opt_engine_type, " .
|
|
"generated $completion_date.\n" .
|
|
"FAILURE: # Original test base was: $list_name.\n" .
|
|
"FAILURE: # $tests_completed of " . ($#test_list + 1) .
|
|
" test(s) were completed, " .
|
|
"$failures_reported failures reported.\n" .
|
|
"FAILURE: Engine command line: $engine_command<br>\n" .
|
|
join ("\n", map { "FAILURE: $_" } @failed_tests) .
|
|
"\n</pre>\n" .
|
|
"[ <a href='#tippy_top'>Top of Page</a> | " .
|
|
"<a href='#retest_list'>Top of Retest List</a> ]<br>\n");
|
|
} else {
|
|
print OUTPUT
|
|
("<h1>Whoop-de-doo, nothing failed!</h1>\n");
|
|
}
|
|
|
|
print OUTPUT "</body>";
|
|
|
|
close (OUTPUT);
|
|
|
|
&status ("Wrote results to '$opt_output_file'.");
|
|
|
|
if ($opt_console_failures) {
|
|
&status ("$failures_reported test(s) failed");
|
|
}
|
|
|
|
}
|
|
|
|
sub next_option {
|
|
my ($key, $val, $implied);
|
|
|
|
return if @ARGV == 0;
|
|
|
|
&dd ("ARGV is now: @ARGV\n");
|
|
|
|
$key = shift @ARGV;
|
|
if ($key =~ s/^--?(.*)/$1/) {
|
|
$implied = 0;
|
|
} else {
|
|
$implied = 1;
|
|
$val = $key;
|
|
$key = $last_option;
|
|
}
|
|
|
|
if ($key =~ /\w+/ and $options =~ /\b$key>(\w+)/) {
|
|
$key = $1;
|
|
}
|
|
|
|
if ($options =~ /\b$key=s\b/) {
|
|
if (!$implied) {
|
|
die "option '$key' requires an argument" if @ARGV == 0;
|
|
$val = shift @ARGV;
|
|
}
|
|
} elsif ($options =~ /(^|\s)$key(\s|$)/) {
|
|
die "option '$key' doesn't take an argument" if $implied;
|
|
$val = 1;
|
|
} else {
|
|
die "can't figure out option '$key'";
|
|
}
|
|
$last_option = $key;
|
|
return ($key, $val);
|
|
}
|
|
|
|
sub parse_args {
|
|
my ($option, $value, $lastopt);
|
|
|
|
&dd ("checking command line options.");
|
|
|
|
while (($option, $value) = next_option()) {
|
|
|
|
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 "K") {
|
|
&dd ("opt: displaying failures on console as single line.");
|
|
$opt_console_failures=1;
|
|
$opt_console_failures_line=1;
|
|
|
|
} elsif ($option eq "R") {
|
|
&dd ("opt: Report summarized test results.");
|
|
$opt_report_summarized_results=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;
|
|
|
|
} elsif ($option eq "T") {
|
|
$opt_timeout = $value;
|
|
&dd ("opt: setting timeout to $opt_timeout.");
|
|
|
|
} elsif ($option eq "n") {
|
|
&dd ("opt: enabling narcissus.");
|
|
$opt_enable_narcissus = 1;
|
|
if ($value) {
|
|
$opt_narcissus_path = $value;
|
|
}
|
|
|
|
} elsif ($option eq "Q") {
|
|
&dd ("opt: disabling interrupt handler.");
|
|
$opt_no_quit = 1;
|
|
|
|
} else {
|
|
&dd ("opt: unknown option $option '$value'.");
|
|
&usage;
|
|
}
|
|
|
|
$lastopt = $option;
|
|
|
|
}
|
|
|
|
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 [<options>] \n" .
|
|
"(-b|--bugurl) Bugzilla URL.\n" .
|
|
" (default is $opt_bug_url)\n" .
|
|
"(-c|--classpath) Classpath (Rhino only.)\n" .
|
|
"(-e|--engine) <type> ... Specify the type of engine(s) to test.\n" .
|
|
" <type> is one or more of\n" .
|
|
" (smopt|smdebug|lcopt|lcdebug|xpcshell|" .
|
|
"rhino|rhinoi|rhinoms|rhinomsi|rhino9|rhinoms9).\n" .
|
|
"(-f|--file) <file> Redirect output to file named <file>.\n" .
|
|
" (default is " .
|
|
"results-<engine-type>-<date-stamp>.html)\n" .
|
|
"(-h|--help) Print this message.\n" .
|
|
"(-j|--javapath) Location of java executable.\n" .
|
|
"(-k|--confail) Log failures to console (also.)\n" .
|
|
"(-K|--linefail) Log failures to console as single line (also.)\n" .
|
|
"(-R|--report) Report summarized test results.\n" .
|
|
"(-l|--list) <file> ... List of tests to execute.\n" .
|
|
"(-L|--neglist) <file> ... List of tests to skip.\n" .
|
|
"(-o|--opt) <options> Options to pass to the JavaScript engine.\n" .
|
|
" (Make sure to quote them!)\n" .
|
|
"(-p|--testpath) <path> Root of the test suite. (default is ./)\n" .
|
|
"(-s|--shellpath) <path> Location of JavaScript shell.\n" .
|
|
"(-t|--trace) Trace script execution.\n" .
|
|
"(-T|--timeout) <seconds> Time in seconds before the test is terminated.\n" .
|
|
" (default is 3600).\n" .
|
|
"(-u|--lxrurl) <url> 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" .
|
|
"(-n|--narcissus)[=<path>] Run the test suite through Narcissus, run\n" .
|
|
" through the given shell. The optional path\n".
|
|
" is the path to Narcissus' js.js file.\n".
|
|
"(-Q|--noquitinthandler) Do not prompt user to Quit, Report or Continue\n".
|
|
" in the event of a user interrupt.\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";
|
|
|
|
if ($opt_enable_narcissus == 1) {
|
|
my $narcissus_path = &get_narcissus_path;
|
|
$retval .= " -f $narcissus_path";
|
|
}
|
|
|
|
&dd ("got '$retval'");
|
|
|
|
return $retval;
|
|
}
|
|
|
|
#
|
|
# get the path to the Narcissus js.js file.
|
|
#
|
|
sub get_narcissus_path {
|
|
my $retval;
|
|
|
|
if ($opt_narcissus_path) {
|
|
$retval = $opt_narcissus_path;
|
|
} else {
|
|
# For now, just assume that we're in js/tests.
|
|
$retval = "../narcissus/js.js";
|
|
}
|
|
|
|
if (!-e $retval) {
|
|
# XXX if it didn't exist, try something more fancy?
|
|
die "Unable to find Narcissus' js.js at $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.");
|
|
|
|
}
|
|
|
|
|
|
# Don't run any shell.js files as tests; they are only utility files
|
|
@test_list = grep (!/shell\.js$/, @test_list);
|
|
|
|
# Don't run any browser.js files as tests; they are only utility files
|
|
@test_list = grep (!/browser\.js$/, @test_list);
|
|
|
|
# Don't run any jsref.js files as tests; they are only utility files
|
|
@test_list = grep (!/jsref\.js$/, @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 (<TESTLIST>) {
|
|
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 ("Don't 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 ($opt_console_failures_line) {
|
|
# report_summary_result increments $failures_reported
|
|
# decrement here to prevent overcounting of failures
|
|
$failures_reported--;
|
|
my $linemessage = $message;
|
|
$linemessage =~ s/[\n\r]+/ /mg;
|
|
$bug_number = "none" unless $bug_number;
|
|
&report_summary_result($test, $bug_number, "FAILED",
|
|
"",
|
|
"",
|
|
"",
|
|
$linemessage);
|
|
} elsif($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/&/&/g;
|
|
$message =~ s/</</g;
|
|
$message =~ s/>/>/g;
|
|
$message =~ s/\n/<br>\n/g;
|
|
|
|
if ($bug_number) {
|
|
my $bug_url = ($bug_number =~ /^\d+$/) ? "$opt_bug_url$bug_number" : $bug_number;
|
|
$bug_line = "<a href='$bug_url' target='other_window'>".
|
|
"Bug Number $bug_number</a>";
|
|
}
|
|
|
|
if ($opt_lxr_url) {
|
|
$test =~ /\/?([^\/]+\/[^\/]+\/[^\/]+)$/;
|
|
$test = $1;
|
|
$html .= "<dd><b>".
|
|
"Testcase <a target='other_window' href='$opt_lxr_url$test'>$1</a> " .
|
|
"failed</b> $bug_line<br>\n";
|
|
} else {
|
|
$html .= "<dd><b>".
|
|
"Testcase $test failed</b> $bug_line<br>\n";
|
|
}
|
|
|
|
$html .= " [ ";
|
|
|
|
$html .= "<a href='#tippy_top'>Top of Page</a> ]<br>\n" .
|
|
"<tt>$message</tt><br>\n";
|
|
|
|
@failed_tests[$#failed_tests + 1] = $test;
|
|
|
|
}
|
|
|
|
sub dd {
|
|
|
|
if ($opt_trace) {
|
|
print ("-*- ", @_ , "\n");
|
|
}
|
|
|
|
}
|
|
|
|
sub status {
|
|
|
|
print ("-#- ", @_ , "\n");
|
|
|
|
}
|
|
|
|
sub int_handler {
|
|
my $resp;
|
|
|
|
if ($current_test_pid)
|
|
{
|
|
print "User Interrupt: killing process $current_test_pid\n";
|
|
kill_process($current_test_pid);
|
|
}
|
|
|
|
do {
|
|
print STDERR ("\n*** User Break: Just [Q]uit, Quit and [R]eport, [C]ontinue ?");
|
|
$resp = <STDIN>;
|
|
} until ($resp =~ /[QqRrCc]/);
|
|
|
|
if ($resp =~ /[Qq]/) {
|
|
print ("User Exit. No results were generated.\n");
|
|
exit;
|
|
} elsif ($resp =~ /[Rr]/) {
|
|
$user_exit = 1;
|
|
}
|
|
|
|
}
|
|
|
|
# XXX: These functions were pulled from
|
|
# lxr.mozilla.org/mozilla/source/tools/tinderbox/build-seamonkey-util.pl
|
|
# need a general reusable library of routines for use in all test programs.
|
|
|
|
sub kill_process {
|
|
my ($target_pid) = @_;
|
|
my $start_time = time;
|
|
|
|
# Try to kill and wait 10 seconds, then try a kill -9
|
|
my $sig;
|
|
for $sig ('TERM', 'KILL') {
|
|
print "kill $sig $target_pid\n";
|
|
kill $sig => $target_pid;
|
|
my $interval_start = time;
|
|
while (time - $interval_start < 10) {
|
|
# the following will work with 'cygwin' perl on win32, but not
|
|
# with 'MSWin32' (ActiveState) perl
|
|
my $pid = waitpid($target_pid, POSIX::WNOHANG());
|
|
if (($pid == $target_pid and POSIX::WIFEXITED($?)) or $pid == -1) {
|
|
my $secs = time - $start_time;
|
|
$secs = $secs == 1 ? '1 second' : "$secs seconds";
|
|
return;
|
|
}
|
|
sleep 1;
|
|
}
|
|
}
|
|
die "Unable to kill process: $target_pid";
|
|
}
|
|
|
|
sub report_summary_result
|
|
{
|
|
my ($test, $bug_number, $result, $description,
|
|
$expected, $actual, $reason) = @_;
|
|
|
|
$description =~ s/[\n\r]+/ /mg;
|
|
$expected =~ s/[\n\r]+/ /mg;
|
|
$actual =~ s/[\n\r]+/ /mg;
|
|
$reason =~ s/[\n\r]+/ /mg;
|
|
|
|
if ($result !~ /PASSED/)
|
|
{
|
|
$failures_reported++;
|
|
}
|
|
|
|
print STDERR ("jstest: $test " .
|
|
"bug: $bug_number " .
|
|
"result: $result " .
|
|
"type: shell " .
|
|
"description: $description " .
|
|
"expected: $expected " .
|
|
"actual: $actual " .
|
|
"reason: $reason" .
|
|
"\n");
|
|
|
|
}
|