#!/usr/bin/perl
#
# ***** 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
# Bob Clary
#
# 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 *****
# Creates the meat of a test suite manager page, requites menuhead.html and menufoot.html
# to create the complete page. The test suite manager lets you choose a subset of tests
# to run under the runtests2.pl script.
local $lxr_url = "http://lxr.mozilla.org/mozilla/source/js/tests/";
local $suite_path = $ARGV[0] || "./";
local $uid = 0; # radio button unique ID
local $html = ""; # html output
local $javascript = ""; # script output
#
# automatically exclude spidermonkey-n.tests
# XXXbc better to emulate jsDriver.pl's option processing
# and allow -L file1 file2 etc.
#
local $excludedtest;
local @excludedlist = expand_user_test_list('spidermonkey-n.tests');
local %excludedhash = {};
foreach $excludedtest (@excludedlist)
{
$excludedhash{"./" . $excludedtest} = 1;
}
&main;
print (&scriptTag($javascript) . "\n");
print ($html);
sub main {
local $i, @suite_list;
if (!($suite_path =~ /\/$/)) {
$suite_path = $suite_path . "/";
}
@suite_list = sort(&get_subdirs ($suite_path));
$javascript .= "\n";
$javascript .= "var suites = {};\n";
$javascript .= "function populateSuites()\n";
$javascript .= "{\n";
$javascript .= "var currSuite;\n";
$javascript .= "var currDirectory;\n";
$javascript .= "var currTestDirs;\n";
$javascript .= "var currTests;\n";
$html .= "
Test Suites:
\n";
$html .= "
\n";
$html .= " \n";
$html .= " \n";
# suite menu
$html .= "
\n";
foreach $suite (@suite_list) {
local @readme_text = ("No description available.");
if (open (README, $suite_path . $suite . "/README")) {
@readme_text = ;
close (README);
}
$html .= "
\n";
}
sub scriptTag {
return ("");
}
#
# given a directory, return an array of all subdirectories
#
sub get_subdirs {
local ($dir) = @_;
local @subdirs;
if (!($dir =~ /\/$/)) {
$dir = $dir . "/";
}
opendir (DIR, $dir) || die ("couldn't open directory $dir: $!");
local @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 {
local ($test_subdir) = @_;
local @js_file_array;
opendir ( TEST_SUBDIR, $test_subdir) || die ("couldn't open directory " .
"$test_subdir: $!");
@subdir_files = readdir( TEST_SUBDIR );
closedir( TEST_SUBDIR );
foreach ( @subdir_files ) {
# print "excluded $test_subdir/$_\n" if $excludedhash{"$test_subdir/$_"};
if ( ($_ =~ /\.js$/) && ($_ ne 'shell.js') && ($_ ne 'browser.js') &&
(!$excludedhash{"$test_subdir/$_"}) ) {
$js_file_array[$#js_file_array+1] = $_;
}
}
return @js_file_array;
}
# copied from jsDriver.pl
#
# 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;
}
sub status {
print STDERR ("-#- ", @_ , "\n");
}