#!/usr/bin/perl

#

# The contents of this file are subject to the Netscape 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/NPL/

#

# 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 Netscape are

# Copyright (C) 1997-1999 Netscape Communications Corporation. All

# Rights Reserved.

#

# Alternatively, the contents of this file may be used under the

# terms of the GNU Public License (the "GPL"), in which case the

# provisions of the GPL are applicable instead of those above.

# If you wish to allow use of your version of this file only

# under the terms of the GPL and not to allow others to use your

# version of this file under the NPL, indicate your decision by

# deleting the provisions above and replace them with the notice

# and other provisions required by the GPL.  If you do not delete

# the provisions above, a recipient may use your version of this

# file under either the NPL or the GPL.

#

# Contributers:

#  Robert Ginda <rginda@netscape.com>

#

# Second cut at runtests.pl script originally by

# Christine Begle (cbegle@netscape.com)

# Branched 11/01/99

#

use strict;

use Getopt::Mixed "nextOption";

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 = "http://bugzilla.mozilla.org/show_bug.cgi?id=";

my $opt_console_failures = 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_arch= "";

# command line option definition

my $options = "a=s arch>a 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 l=s list>l L=s neglist>L " .

"o=s opt>o p=s testpath>p s=s shellpath>s t trace>t u=s lxrurl>u " .

"x noexitmunge>x";

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) {

# 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';

}

&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 execute_tests {

    my (@test_list) = @_;

    my ($test, $shell_command, $line, @output, $path);

    my $file_param = " -f ";

    my ($last_suite, $last_test_dir);

# Don't run any shell.js files as tests; they are only utility files

    @test_list = grep (!/shell\.js$/, @test_list);

    &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;

# user selected [Q]uit from ^C handler.

        if ($user_exit) {

            return;

        }

# 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 = $opt_arch . " ";

            $shell_command .= &xp_path($engine_command)  . " -s ";

            $path = &xp_path($opt_suite_path . $suite . "/shell.js");

            if (-f $path) {

                $shell_command .= $file_param . $path;

            }

            $path = &xp_path($opt_suite_path . $suite . "/" .

                             $test_dir . "/shell.js");

            if (-f $path) {

                $shell_command .= $file_param . $path;

            }

            $last_suite = $suite;

            $last_test_dir = $test_dir;

        }

        $path = &xp_path($opt_suite_path . $test);

        print ($shell_command . $file_param . $path . "\n");

        &dd ("executing: " . $shell_command . $file_param . $path);

        open (OUTPUT, $shell_command . $file_param . $path .

              $redirect_command . " |");

        @output = <OUTPUT>;

        close (OUTPUT);

        @output = grep (!/js\>/, @output);

        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;

        }

        $failure_lines = "";

        $bug_number = "";

        $status_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;

                &dd ("Test case expects exit code $expected_exit");

            }

# watch for failures

            if ($line =~ /failed!/i) {

                $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) {

                $1 =~ /(\n+)/;

                $bug_number = $1;

            }

# and watch for status

            if ($line =~ /status/i) {

                $status_lines .= $line;

            }

        }

        if (!@output) {

            @output = ("Testcase produced no output!");

        }

        if ($got_exit != $expected_exit) {

# 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) {

        print OUTPUT

        ("[ <a href='#fail_detail'>Failure Details</a> | " .

         "<a href='#retest_list'>Retest List</a> | " .

         "<a href='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<pre>\n" .

         "<a name='retest_list'></a>\n" .

         "<h2>Retest List</h2><br>\n" .

         "# Retest List, $opt_engine_type, " .

         "generated $completion_date.\n" .

         "# Original test base was: $list_name.\n" .

         "# $tests_completed of " . ($#test_list + 1) .

         " test(s) were completed, " .

         "$failures_reported failures reported.\n" .

         join ("\n", @failed_tests) );

#"</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 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 "a") {

            &dd ("opt: running with architecture $value.");

            $value =~ s/^ //;

            $opt_arch = "arch -$value";

        } elsif ($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 [<options>] \n" .

     "(-a|--arch) <arch>        run with a specific architecture on mac\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" .

     "                          (squirrelfish|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" . 

     "(-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" .

     "(-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");

    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;