7dbdc8e16ac8d7883a3ed732d22c458431895ad2
[WebKit-https.git] / JavaScriptCore / tests / mozilla / jsDriver.pl
1 #!/usr/bin/perl
2 #
3 # The contents of this file are subject to the Netscape Public
4 # License Version 1.1 (the "License"); you may not use this file
5 # except in compliance with the License. You may obtain a copy of
6 # the License at http://www.mozilla.org/NPL/
7 #
8 # Software distributed under the License is distributed on an "AS
9 # IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
10 # implied. See the License for the specific language governing
11 # rights and limitations under the License.
12 #
13 # The Original Code is JavaScript Core Tests.
14 #
15 # The Initial Developer of the Original Code is Netscape
16 # Communications Corporation.  Portions created by Netscape are
17 # Copyright (C) 1997-1999 Netscape Communications Corporation. All
18 # Rights Reserved.
19 #
20 # Alternatively, the contents of this file may be used under the
21 # terms of the GNU Public License (the "GPL"), in which case the
22 # provisions of the GPL are applicable instead of those above.
23 # If you wish to allow use of your version of this file only
24 # under the terms of the GPL and not to allow others to use your
25 # version of this file under the NPL, indicate your decision by
26 # deleting the provisions above and replace them with the notice
27 # and other provisions required by the GPL.  If you do not delete
28 # the provisions above, a recipient may use your version of this
29 # file under either the NPL or the GPL.
30 #
31 # Contributers:
32 #  Robert Ginda <rginda@netscape.com>
33 #
34 # Second cut at runtests.pl script originally by
35 # Christine Begle (cbegle@netscape.com)
36 # Branched 11/01/99
37 #
38
39 use strict;
40 use Getopt::Mixed "nextOption";
41
42 my $os_type = &get_os_type;
43 my $unixish = (($os_type ne "WIN") && ($os_type ne "MAC"));
44 my $path_sep = ($os_type eq "MAC") ? ":" : "/";
45 my $win_sep  = ($os_type eq "WIN")? &get_win_sep : "";
46 my $redirect_command = ($os_type ne "MAC") ? " 2>&1" : "";
47
48 # command line option defaults
49 my $opt_suite_path;
50 my $opt_trace = 0;
51 my $opt_classpath = "";
52 my $opt_rhino_opt = 0;
53 my $opt_rhino_ms = 0;
54 my @opt_engine_list;
55 my $opt_engine_type = "";
56 my $opt_engine_params = "";
57 my $opt_user_output_file = 0;
58 my $opt_output_file = "";
59 my @opt_test_list_files;
60 my @opt_neg_list_files;
61 my $opt_shell_path = "";
62 my $opt_java_path = "";
63 my $opt_bug_url = "http://bugzilla.mozilla.org/show_bug.cgi?id=";
64 my $opt_console_failures = 0;
65 my $opt_lxr_url = "http://lxr.mozilla.org/mozilla/source/js/tests/";
66 my $opt_exit_munge = ($os_type ne "MAC") ? 1 : 0;
67
68 # command line option definition
69 my $options = "b=s bugurl>b c=s classpath>c e=s engine>e f=s file>f " .
70   "h help>h i j=s javapath>j k confail>k l=s list>l L=s neglist>L " .
71   "o=s opt>o p=s testpath>p s=s shellpath>s t trace>t u=s lxrurl>u " .
72   "x noexitmunge>x";
73
74 if ($os_type eq "MAC") {
75     $opt_suite_path = `directory`;
76     $opt_suite_path =~ s/[\n\r]//g;
77     $opt_suite_path .= ":";
78 } else {
79     $opt_suite_path = "./";
80 }
81
82 &parse_args;
83
84 my $user_exit = 0;
85 my ($engine_command, $html, $failures_reported, $tests_completed,
86     $exec_time_string); 
87 my @failed_tests;
88 my @test_list = &get_test_list;
89
90 if ($#test_list == -1) {
91     die ("Nothing to test.\n");
92 }
93
94 if ($unixish) {
95     # on unix, ^C pauses the tests, and gives the user a chance to quit but 
96     # report on what has been done, to just quit, or to continue (the
97     # interrupted test will still be skipped.)
98     # windows doesn't handle the int handler they way we want it to,
99     # so don't even pretend to let the user continue.
100     $SIG{INT} = 'int_handler';
101 }
102
103 &main;
104
105 #End.
106
107 sub main {
108     my $start_time;
109
110     while ($opt_engine_type = pop (@opt_engine_list)) {
111         dd ("Testing engine '$opt_engine_type'");
112
113         $engine_command = &get_engine_command;
114         $html = "";
115         @failed_tests = ();
116         $failures_reported = 0;
117         $tests_completed = 0;
118         $start_time = time;
119
120
121         &execute_tests (@test_list);
122
123         my $exec_time = (time - $start_time);
124         my $exec_hours = int($exec_time / 60 / 60);
125         $exec_time -= $exec_hours * 60 * 60;
126         my $exec_mins = int($exec_time / 60);
127         $exec_time -= $exec_mins * 60;
128         my $exec_secs = ($exec_time % 60);
129
130         if ($exec_hours > 0) {
131             $exec_time_string = "$exec_hours hours, $exec_mins minutes, " .
132               "$exec_secs seconds";
133         } elsif ($exec_mins > 0) {
134             $exec_time_string = "$exec_mins minutes, $exec_secs seconds";
135         } else {
136             $exec_time_string = "$exec_secs seconds";
137         }
138
139         if (!$opt_user_output_file) {
140             $opt_output_file = &get_tempfile_name;
141         }
142
143         &write_results;
144
145     }
146 }
147
148 sub execute_tests {
149     my (@test_list) = @_;
150     my ($test, $shell_command, $line, @output, $path);
151     my $file_param = " -f ";
152     my ($last_suite, $last_test_dir);
153
154     &status ("Executing " . ($#test_list + 1) . " test(s).");
155
156     foreach $test (@test_list) {
157         my ($suite, $test_dir, $test_file) = split($path_sep, $test);
158         # *-n.js is a negative test, expect exit code 3 (runtime error)
159         my $expected_exit = ($test =~ /\-n\.js$/) ? 3 : 0;
160         my ($got_exit, $exit_signal);
161         my $failure_lines;
162         my $bug_number;
163         my $status_lines;
164
165         # user selected [Q]uit from ^C handler.
166         if ($user_exit) {
167             return;
168         }
169
170         # Append the shell.js files to the shell_command if they're there.
171         # (only check for their existance if the suite or test_dir has changed
172         # since the last time we looked.)
173         if ($last_suite ne $suite || $last_test_dir ne $test_dir) {
174             $shell_command = &xp_path($engine_command);
175
176             $path = &xp_path($opt_suite_path . $suite . "/shell.js");
177             if (-f $path) {
178                 $shell_command .= $file_param . $path;
179             }
180
181             $path = &xp_path($opt_suite_path . $suite . "/" .
182                              $test_dir . "/shell.js");
183             if (-f $path) {
184                 $shell_command .= $file_param . $path;
185             }
186
187             $last_suite = $suite;
188             $last_test_dir = $test_dir;
189         }
190          
191         $path = &xp_path($opt_suite_path . $test);
192         &dd ("executing: " . $shell_command . $file_param . $path);
193
194         open (OUTPUT, $shell_command . $file_param . $path .
195               $redirect_command . " |");
196         @output = <OUTPUT>;
197         close (OUTPUT);
198
199         @output = grep (!/js\>/, @output);
200
201         if ($opt_exit_munge == 1) {
202             # signal information in the lower 8 bits, exit code above that
203             $got_exit = ($? >> 8);
204             $exit_signal = ($? & 255);
205         } else {
206             # user says not to munge the exit code
207             $got_exit = $?;
208             $exit_signal = 0;
209         }
210
211         $failure_lines = "";
212         $bug_number = "";
213         $status_lines = "";
214
215         foreach $line (@output) {
216
217             # watch for testcase to proclaim what exit code it expects to
218             # produce (0 by default)
219             if ($line =~ /expect(ed)?\s*exit\s*code\s*\:?\s*(\d+)/i) {
220                 $expected_exit = $2;
221                 &dd ("Test case expects exit code $expected_exit");
222             }
223
224             # watch for failures
225             if ($line =~ /failed!/i) {
226                 $failure_lines .= $line;
227             }
228
229             # and watch for bugnumbers
230             # XXX This only allows 1 bugnumber per testfile, should be
231             # XXX modified to allow for multiple.
232             if ($line =~ /bugnumber\s*\:?\s*(.*)/i) {
233                 $1 =~ /(\n+)/;
234                 $bug_number = $1;
235             }
236
237             # and watch for status
238             if ($line =~ /status/i) {
239                 $status_lines .= $line;
240             }
241
242         }
243
244         if (!@output) {
245             @output = ("Testcase produced no output!");
246         }
247
248         if ($got_exit != $expected_exit) {
249             # full testcase output dumped on mismatched exit codes,
250             &report_failure ($test, "Expected exit code " .
251                              "$expected_exit, got $got_exit\n" .
252                              "Testcase terminated with signal $exit_signal\n" .
253                              "Complete testcase output was:\n" .
254                              join ("\n",@output), $bug_number);
255         } elsif ($failure_lines) {
256             # only offending lines if exit codes matched
257             &report_failure ($test, "$status_lines\n".
258                              "Failure messages were:\n$failure_lines",
259                              $bug_number);
260         }
261
262         &dd ("exit code $got_exit, exit signal $exit_signal.");
263
264         $tests_completed++;
265     }
266 }
267
268 sub write_results {
269     my ($list_name, $neglist_name);
270     my $completion_date = localtime;
271     my $failure_pct = int(($failures_reported / $tests_completed) * 10000) /
272       100;
273     &dd ("Writing output to $opt_output_file.");
274
275     if ($#opt_test_list_files == -1) {
276         $list_name = "All tests";
277     } elsif ($#opt_test_list_files < 10) {
278         $list_name = join (", ", @opt_test_list_files);
279     } else {
280         $list_name = "($#opt_test_list_files test files specified)";
281     }
282
283     if ($#opt_neg_list_files == -1) {
284         $neglist_name = "(none)";
285     } elsif ($#opt_test_list_files < 10) {
286         $neglist_name = join (", ", @opt_neg_list_files);
287     } else {
288         $neglist_name = "($#opt_neg_list_files skip files specified)";
289     }
290
291     open (OUTPUT, "> $opt_output_file") ||
292       die ("Could not create output file $opt_output_file");
293
294     print OUTPUT 
295       ("<html><head>\n" .
296        "<title>Test results, $opt_engine_type</title>\n" .
297        "</head>\n" .
298        "<body bgcolor='white'>\n" .
299        "<a name='tippy_top'></a>\n" .
300        "<h2>Test results, $opt_engine_type</h2><br>\n" .
301        "<p class='results_summary'>\n" .
302        "Test List: $list_name<br>\n" .
303        "Skip List: $neglist_name<br>\n" .
304        ($#test_list + 1) . " test(s) selected, $tests_completed test(s) " .
305        "completed, $failures_reported failures reported " .
306        "($failure_pct% failed)<br>\n" .
307        "Engine command line: $engine_command<br>\n" .
308        "OS type: $os_type<br>\n");
309
310     if ($opt_engine_type =~ /^rhino/) {
311         open (JAVAOUTPUT, $opt_java_path . "java -fullversion " .
312               $redirect_command . " |");
313         print OUTPUT <JAVAOUTPUT>;
314         print OUTPUT "<BR>";
315         close (JAVAOUTPUT);
316     }
317
318     print OUTPUT 
319       ("Testcase execution time: $exec_time_string.<br>\n" .
320        "Tests completed on $completion_date.<br><br>\n");
321
322     if ($failures_reported > 0) {
323         print OUTPUT
324           ("[ <a href='#fail_detail'>Failure Details</a> | " .
325            "<a href='#retest_list'>Retest List</a> | " .
326            "<a href='menu.html'>Test Selection Page</a> ]<br>\n" .
327            "<hr>\n" .
328            "<a name='fail_detail'></a>\n" .
329            "<h2>Failure Details</h2><br>\n<dl>" .
330            $html .
331            "</dl>\n[ <a href='#tippy_top'>Top of Page</a> | " .
332            "<a href='#fail_detail'>Top of Failures</a> ]<br>\n" .
333            "<hr>\n" .
334            "<a name='retest_list'></a>\n" .
335            "<h2>Retest List</h2><br>\n" .
336            "<pre>\n" .
337            "# Retest List, $opt_engine_type, " .
338            "generated $completion_date.\n" .
339            "# Original test base was: $list_name.\n" .
340            "# $tests_completed of " . ($#test_list + 1) .
341            " test(s) were completed, " .
342            "$failures_reported failures reported.\n" .
343            join ("\n", @failed_tests) .
344            "</pre>\n" .
345            "[ <a href='#tippy_top'>Top of Page</a> | " .
346            "<a href='#retest_list'>Top of Retest List</a> ]<br>\n");
347     } else {
348         print OUTPUT 
349           ("<h1>Whoop-de-doo, nothing failed!</h1>\n");
350     }
351
352     print OUTPUT "</body>";
353
354     close (OUTPUT);
355
356     &status ("Wrote results to '$opt_output_file'.");
357
358     if ($opt_console_failures) {
359         &status ("$failures_reported test(s) failed");
360     }
361
362 }
363
364 sub parse_args {
365     my ($option, $value, $lastopt);
366
367     &dd ("checking command line options.");
368
369     Getopt::Mixed::init ($options);
370     $Getopt::Mixed::order = $Getopt::Mixed::RETURN_IN_ORDER;
371
372     while (($option, $value) = nextOption()) {
373
374         if ($option eq "b") {
375             &dd ("opt: setting bugurl to '$value'.");
376             $opt_bug_url = $value;
377
378         } elsif ($option eq "c") {
379             &dd ("opt: setting classpath to '$value'.");
380             $opt_classpath = $value;
381
382         } elsif (($option eq "e") || (($option eq "") && ($lastopt eq "e"))) {
383             &dd ("opt: adding engine $value.");
384             push (@opt_engine_list, $value);
385
386         } elsif ($option eq "f") {
387             if (!$value) {
388                 die ("Output file cannot be null.\n");
389             }
390             &dd ("opt: setting output file to '$value'.");
391             $opt_user_output_file = 1;
392             $opt_output_file = $value;
393
394         } elsif ($option eq "h") {
395             &usage;
396
397         } elsif ($option eq "j") {
398             if (!($value =~ /[\/\\]$/)) {
399                 $value .= "/";
400             }
401             &dd ("opt: setting java path to '$value'.");
402             $opt_java_path = $value;
403
404         } elsif ($option eq "k") {
405             &dd ("opt: displaying failures on console.");
406             $opt_console_failures=1;
407
408         } elsif ($option eq "l" || (($option eq "") && ($lastopt eq "l"))) {
409             $option = "l";
410             &dd ("opt: adding test list '$value'.");
411             push (@opt_test_list_files, $value);
412
413         } elsif ($option eq "L" || (($option eq "") && ($lastopt eq "L"))) {
414             $option = "L";
415             &dd ("opt: adding negative list '$value'.");
416             push (@opt_neg_list_files, $value);
417
418         } elsif ($option eq "o") {
419             $opt_engine_params = $value;
420             &dd ("opt: setting engine params to '$opt_engine_params'.");
421
422         } elsif ($option eq "p") {
423             $opt_suite_path = $value;
424
425             if ($os_type eq "MAC") {
426                 if (!($opt_suite_path =~ /\:$/)) {
427                     $opt_suite_path .= ":";
428                 }
429             } else {
430                 if (!($opt_suite_path =~ /[\/\\]$/)) {
431                     $opt_suite_path .= "/";
432                 }
433             }
434
435             &dd ("opt: setting suite path to '$opt_suite_path'.");
436
437         } elsif ($option eq "s") {
438             $opt_shell_path = $value;
439             &dd ("opt: setting shell path to '$opt_shell_path'.");
440
441         } elsif ($option eq "t") {
442             &dd ("opt: tracing output.  (console failures at no extra charge.)");
443             $opt_console_failures = 1;
444             $opt_trace = 1;
445
446         } elsif ($option eq "u") {
447             &dd ("opt: setting lxr url to '$value'.");
448             $opt_lxr_url = $value;
449
450         } elsif ($option eq "x") {
451             &dd ("opt: turning off exit munging.");
452             $opt_exit_munge = 0;
453
454         } else {
455             &usage;
456         }
457
458         $lastopt = $option;
459
460     }
461
462     Getopt::Mixed::cleanup();
463
464     if ($#opt_engine_list == -1) {
465         die "You must select a shell to test in.\n";
466     }
467
468 }
469
470 #
471 # print the arguments that this script expects
472 #
473 sub usage {
474     print STDERR 
475       ("\nusage: $0 [<options>] \n" .
476        "(-b|--bugurl)             Bugzilla URL.\n" .
477        "                          (default is $opt_bug_url)\n" .
478        "(-c|--classpath)          Classpath (Rhino only.)\n" .
479        "(-e|--engine) <type> ...  Specify the type of engine(s) to test.\n" .
480        "                          <type> is one or more of\n" .
481        "                          (smopt|smdebug|lcopt|lcdebug|xpcshell|" .
482        "rhino|rhinoi|rhinoms|rhinomsi|rhino9|rhinoms9).\n" .
483        "(-f|--file) <file>        Redirect output to file named <file>.\n" .
484        "                          (default is " .
485        "results-<engine-type>-<date-stamp>.html)\n" .
486        "(-h|--help)               Print this message.\n" .
487        "(-j|--javapath)           Location of java executable.\n" .
488        "(-k|--confail)            Log failures to console (also.)\n" . 
489        "(-l|--list) <file> ...    List of tests to execute.\n" . 
490        "(-L|--neglist) <file> ... List of tests to skip.\n" . 
491        "(-o|--opt) <options>      Options to pass to the JavaScript engine.\n" .
492        "                          (Make sure to quote them!)\n" .
493        "(-p|--testpath) <path>    Root of the test suite. (default is ./)\n" .
494        "(-s|--shellpath) <path>   Location of JavaScript shell.\n" .
495        "(-t|--trace)              Trace script execution.\n" .
496        "(-u|--lxrurl) <url>       Complete URL to tests subdirectory on lxr.\n" .
497        "                          (default is $opt_lxr_url)\n" .
498        "(-x|--noexitmunge)        Don't do exit code munging (try this if it\n" .
499        "                          seems like your exit codes are turning up\n" .
500        "                          as exit signals.)\n");
501     exit (1);
502
503 }
504
505 #
506 # get the shell command used to start the (either) engine
507 #
508 sub get_engine_command {
509
510     my $retval;
511
512     if ($opt_engine_type eq "rhino") {
513         &dd ("getting rhino engine command.");
514         $opt_rhino_opt = 0;
515         $opt_rhino_ms = 0;
516         $retval = &get_rhino_engine_command;
517     } elsif ($opt_engine_type eq "rhinoi") {
518         &dd ("getting rhinoi engine command.");
519         $opt_rhino_opt = -1;
520         $opt_rhino_ms = 0;
521         $retval = &get_rhino_engine_command;
522     } elsif ($opt_engine_type eq "rhino9") {
523         &dd ("getting rhino engine command.");
524         $opt_rhino_opt = 9;
525         $opt_rhino_ms = 0;
526         $retval = &get_rhino_engine_command;
527     } elsif ($opt_engine_type eq "rhinoms") {
528         &dd ("getting rhinoms engine command.");
529         $opt_rhino_opt = 0;
530         $opt_rhino_ms = 1;
531         $retval = &get_rhino_engine_command;
532     } elsif ($opt_engine_type eq "rhinomsi") {
533         &dd ("getting rhinomsi engine command.");
534         $opt_rhino_opt = -1;
535         $opt_rhino_ms = 1;
536         $retval = &get_rhino_engine_command;
537     } elsif ($opt_engine_type eq "rhinoms9") {
538         &dd ("getting rhinomsi engine command.");
539         $opt_rhino_opt = 9;
540         $opt_rhino_ms = 1;
541         $retval = &get_rhino_engine_command;
542     } elsif ($opt_engine_type eq "xpcshell") {
543         &dd ("getting xpcshell engine command.");
544         $retval = &get_xpc_engine_command;
545     } elsif ($opt_engine_type =~ /^lc(opt|debug)$/) {
546         &dd ("getting liveconnect engine command.");
547         $retval = &get_lc_engine_command;   
548     } elsif ($opt_engine_type =~ /^sm(opt|debug)$/) {
549         &dd ("getting spidermonkey engine command.");
550         $retval = &get_sm_engine_command;
551     }  elsif ($opt_engine_type =~ /^ep(opt|debug)$/) {
552         &dd ("getting epimetheus engine command.");
553         $retval = &get_ep_engine_command;
554     } else {
555         die ("Unknown engine type selected, '$opt_engine_type'.\n");
556     }
557
558     $retval .= " $opt_engine_params";
559
560     &dd ("got '$retval'");
561
562     return $retval;
563
564 }
565
566 #
567 # get the shell command used to run rhino
568 #
569 sub get_rhino_engine_command {
570     my $retval = $opt_java_path . ($opt_rhino_ms ? "jview " : "java ");
571
572     if ($opt_shell_path) {
573         $opt_classpath = ($opt_classpath) ?
574           $opt_classpath . ":" . $opt_shell_path :
575             $opt_shell_path;
576     }
577
578     if ($opt_classpath) {
579         $retval .= ($opt_rhino_ms ? "/cp:p" : "-classpath") . " $opt_classpath ";
580     }
581
582     $retval .= "org.mozilla.javascript.tools.shell.Main";
583
584     if ($opt_rhino_opt) {
585         $retval .= " -opt $opt_rhino_opt";
586     }
587
588     return $retval;
589
590 }
591
592 #
593 # get the shell command used to run xpcshell
594 #
595 sub get_xpc_engine_command {
596     my $retval;
597     my $m5_home = @ENV{"MOZILLA_FIVE_HOME"} ||
598       die ("You must set MOZILLA_FIVE_HOME to use the xpcshell" ,
599            (!$unixish) ? "." : ", also " .
600            "setting LD_LIBRARY_PATH to the same directory may get rid of " .
601            "any 'library not found' errors.\n");
602
603     if (($unixish) && (!@ENV{"LD_LIBRARY_PATH"})) {
604         print STDERR "-#- WARNING: LD_LIBRARY_PATH is not set, xpcshell may " .
605           "not be able to find the required components.\n";
606     }
607
608     if (!($m5_home =~ /[\/\\]$/)) {
609         $m5_home .= "/";
610     }
611
612     $retval = $m5_home . "xpcshell";
613
614     if ($os_type eq "WIN") {
615         $retval .= ".exe";
616     }
617
618     $retval = &xp_path($retval);
619
620     if (($os_type ne "MAC") && !(-x $retval)) {
621         # mac doesn't seem to deal with -x correctly
622         die ($retval . " is not a valid executable on this system.\n");
623     }
624
625     return $retval;
626
627 }
628
629 #
630 # get the shell command used to run spidermonkey
631 #
632 sub get_sm_engine_command {
633     my $retval;
634
635     # Look for Makefile.ref style make first.
636     # (On Windows, spidermonkey can be made by two makefiles, each putting the
637     # executable in a diferent directory, under a different name.)
638
639     if ($opt_shell_path) {
640         # if the user provided a path to the shell, return that.
641         $retval = $opt_shell_path;
642
643     } else {
644
645         if ($os_type eq "MAC") {
646             $retval = $opt_suite_path . ":src:macbuild:JS";
647         } else {
648             $retval = $opt_suite_path . "../src/";
649             opendir (SRC_DIR_FILES, $retval);
650             my @src_dir_files = readdir(SRC_DIR_FILES);
651             closedir (SRC_DIR_FILES);
652
653             my ($dir, $object_dir);
654             my $pattern = ($opt_engine_type eq "smdebug") ?
655               'DBG.OBJ' : 'OPT.OBJ';
656
657             # scan for the first directory matching
658             # the pattern expected to hold this type (debug or opt) of engine
659             foreach $dir (@src_dir_files) {
660                 if ($dir =~ $pattern) {
661                     $object_dir = $dir;
662                     last;
663                 }
664             }
665
666             if (!$object_dir && $os_type ne "WIN") {
667                 die ("Could not locate an object directory in $retval " .
668                      "matching the pattern *$pattern.  Have you built the " .
669                      "engine?\n");
670             }
671
672             if (!(-x $retval . $object_dir . "/js.exe") && ($os_type eq "WIN")) {
673                 # On windows, you can build with js.mak as well as Makefile.ref
674                 # (Can you say WTF boys and girls?  I knew you could.)
675                 # So, if the exe the would have been built by Makefile.ref isn't 
676                 # here, check for the js.mak version before dying.
677                 if ($opt_shell_path) {
678                     $retval = $opt_shell_path;
679                     if (!($retval =~ /[\/\\]$/)) {
680                         $retval .= "/";
681                     }
682                 } else {
683                     if ($opt_engine_type eq "smopt") {
684                         $retval = "../src/Release/";
685                     } else {
686                         $retval = "../src/Debug/";
687                     }
688                 }
689
690                 $retval .= "jsshell.exe";
691
692             } else {
693                 $retval .= $object_dir . "/js";
694                 if ($os_type eq "WIN") {
695                     $retval .= ".exe";
696                 }
697             }
698         } # mac/ not mac
699
700         $retval = &xp_path($retval);
701
702     } # (user provided a path)
703
704
705     if (($os_type ne "MAC") && !(-x $retval)) {
706         # mac doesn't seem to deal with -x correctly
707         die ($retval . " is not a valid executable on this system.\n");
708     }
709
710     return $retval;
711
712 }
713
714 #
715 # get the shell command used to run epimetheus
716 #
717 sub get_ep_engine_command {
718     my $retval;
719
720     if ($opt_shell_path) {
721         # if the user provided a path to the shell, return that -
722         $retval = $opt_shell_path;
723
724     } else {
725         my $dir;
726         my $os;
727         my $debug;
728         my $opt;
729         my $exe;
730
731         $dir = $opt_suite_path . "../../js2/src/";
732
733         if ($os_type eq "MAC") {
734             #
735             # On the Mac, the debug and opt builds lie in the same directory -
736             #
737             $os = "macbuild:";
738             $debug = "";
739             $opt = "";
740             $exe = "JS2";
741         } elsif ($os_type eq "WIN") {
742             $os = "winbuild/Epimetheus/";
743             $debug = "Debug/";
744             $opt = "Release/";
745             $exe = "Epimetheus.exe";
746         } else {
747             $os = "";
748             $debug = "";
749             $opt = "";    # <<<----- XXX THIS IS NOT RIGHT! CHANGE IT!
750             $exe = "epimetheus";
751         }
752
753
754         if ($opt_engine_type eq "epdebug") {
755             $retval = $dir . $os . $debug . $exe;
756         } else {
757             $retval = $dir . $os . $opt . $exe;
758         }
759
760         $retval = &xp_path($retval);
761
762     }# (user provided a path)
763
764
765     if (($os_type ne "MAC") && !(-x $retval)) {
766         # mac doesn't seem to deal with -x correctly
767         die ($retval . " is not a valid executable on this system.\n");
768     }
769
770     return $retval;
771 }
772
773 #
774 # get the shell command used to run the liveconnect shell
775 #
776 sub get_lc_engine_command {
777     my $retval;
778
779     if ($opt_shell_path) {
780         $retval = $opt_shell_path;
781     } else {
782         if ($os_type eq "MAC") {
783             die "Don't know how to run the lc shell on the mac yet.\n";
784         } else {
785             $retval = $opt_suite_path . "../src/liveconnect/";
786             opendir (SRC_DIR_FILES, $retval);
787             my @src_dir_files = readdir(SRC_DIR_FILES);
788             closedir (SRC_DIR_FILES);
789
790             my ($dir, $object_dir);
791             my $pattern = ($opt_engine_type eq "lcdebug") ?
792               'DBG.OBJ' : 'OPT.OBJ';
793
794             foreach $dir (@src_dir_files) {
795                 if ($dir =~ $pattern) {
796                     $object_dir = $dir;
797                     last;
798                 }
799             }
800
801             if (!$object_dir) {
802                 die ("Could not locate an object directory in $retval " .
803                      "matching the pattern *$pattern.  Have you built the " .
804                      "engine?\n");
805             }
806
807             $retval .= $object_dir . "/";
808
809             if ($os_type eq "WIN") {
810                 $retval .= "lcshell.exe";
811             } else {
812                 $retval .= "lcshell";
813             }
814         } # mac/ not mac
815
816         $retval = &xp_path($retval);
817
818     } # (user provided a path)
819
820
821     if (($os_type ne "MAC") && !(-x $retval)) {
822         # mac doesn't seem to deal with -x correctly
823         die ("$retval is not a valid executable on this system.\n");
824     }
825
826     return $retval;
827
828 }
829
830 sub get_os_type {
831
832     if ("\n" eq "\015") {
833         return "MAC";
834     }
835
836     my $uname = `uname -a`;
837
838     if ($uname =~ /WIN/) {
839         $uname = "WIN";
840     } else {
841         chop $uname;
842     }
843
844     &dd ("get_os_type returning '$uname'.");
845     return $uname;
846
847 }
848
849 sub get_test_list {
850     my @test_list;
851     my @neg_list;
852
853     if ($#opt_test_list_files > -1) {
854         my $list_file;
855
856         &dd ("getting test list from user specified source.");
857
858         foreach $list_file (@opt_test_list_files) {
859             push (@test_list, &expand_user_test_list($list_file));
860         }
861     } else {
862         &dd ("no list file, groveling in '$opt_suite_path'.");
863
864         @test_list = &get_default_test_list($opt_suite_path);
865     }
866
867     if ($#opt_neg_list_files > -1) {
868         my $list_file;
869         my $orig_size = $#test_list + 1;
870         my $actually_skipped;
871
872         &dd ("getting negative list from user specified source.");
873
874         foreach $list_file (@opt_neg_list_files) {
875             push (@neg_list, &expand_user_test_list($list_file));
876         }
877
878         @test_list = &subtract_arrays (\@test_list, \@neg_list);
879
880         $actually_skipped = $orig_size - ($#test_list + 1);
881
882         &dd ($actually_skipped . " of " . $orig_size .
883              " tests will be skipped.");
884         &dd ((($#neg_list + 1) - $actually_skipped) . " skip tests were " .
885              "not actually part of the test list.");
886
887     }
888
889
890     # Don't run any shell.js files as tests; they are only utility files
891     @test_list = grep (!/shell\.js$/, @test_list);
892
893     return @test_list;
894
895 }
896
897 #
898 # reads $list_file, storing non-comment lines into an array.
899 # lines in the form suite_dir/[*] or suite_dir/test_dir/[*] are expanded
900 # to include all test files under the specified directory
901 #
902 sub expand_user_test_list {
903     my ($list_file) = @_;
904     my @retval = ();
905
906     #
907     # Trim off the leading path separator that begins relative paths on the Mac.
908     # Each path will get concatenated with $opt_suite_path, which ends in one.
909     #
910     # Also note:
911     #
912     # We will call expand_test_list_entry(), which does pattern-matching on $list_file.
913     # This will make the pattern-matching the same as it would be on Linux/Windows -
914     #
915     if ($os_type eq "MAC") {
916         $list_file =~ s/^$path_sep//;
917     }
918
919     if ($list_file =~ /\.js$/ || -d $opt_suite_path . $list_file) {
920
921         push (@retval, &expand_test_list_entry($list_file));
922
923     } else {
924
925         open (TESTLIST, $list_file) ||
926           die("Error opening test list file '$list_file': $!\n");
927
928         while (<TESTLIST>) {
929             s/\r*\n*$//;
930             if (!(/\s*\#/)) {
931                 # It's not a comment, so process it
932                 push (@retval, &expand_test_list_entry($_));
933             }
934         }
935
936         close (TESTLIST);
937
938     }
939
940     return @retval;
941
942 }
943
944
945 #
946 # Currently expect all paths to be RELATIVE to the top-level tests directory.
947 # One day, this should be improved to allow absolute paths as well -
948 #
949 sub expand_test_list_entry {
950     my ($entry) = @_;
951     my @retval;
952
953     if ($entry =~ /\.js$/) {
954         # it's a regular entry, add it to the list
955         if (-f $opt_suite_path . $entry) {
956             push (@retval, $entry);
957         } else {
958             status ("testcase '$entry' not found.");
959         }
960     } elsif ($entry =~ /(.*$path_sep[^\*][^$path_sep]*)$path_sep?\*?$/) {
961         # Entry is in the form suite_dir/test_dir[/*]
962         # so iterate all tests under it
963         my $suite_and_test_dir = $1;
964         my @test_files = &get_js_files ($opt_suite_path . 
965                                         $suite_and_test_dir);
966         my $i;
967
968         foreach $i (0 .. $#test_files) {
969             $test_files[$i] = $suite_and_test_dir . $path_sep .
970               $test_files[$i];
971         }
972
973         splice (@retval, $#retval + 1, 0, @test_files);
974
975     } elsif ($entry =~ /([^\*][^$path_sep]*)$path_sep?\*?$/) {
976         # Entry is in the form suite_dir[/*]
977         # so iterate all test dirs and tests under it
978         my $suite = $1;
979         my @test_dirs = &get_subdirs ($opt_suite_path . $suite);
980         my $test_dir;
981
982         foreach $test_dir (@test_dirs) {
983             my @test_files = &get_js_files ($opt_suite_path . $suite .
984                                             $path_sep . $test_dir);
985             my $i;
986
987             foreach $i (0 .. $#test_files) {
988                 $test_files[$i] = $suite . $path_sep . $test_dir . $path_sep .
989                   $test_files[$i];
990             }
991
992             splice (@retval, $#retval + 1, 0, @test_files);
993         }
994
995     } else {
996         die ("Dont know what to do with list entry '$entry'.\n");
997     }
998
999     return @retval;
1000
1001 }
1002
1003 #
1004 # Grovels through $suite_path, searching for *all* test files.  Used when the
1005 # user doesn't supply a test list.
1006 #
1007 sub get_default_test_list {
1008     my ($suite_path) = @_;
1009     my @suite_list = &get_subdirs($suite_path);
1010     my $suite;
1011     my @retval;
1012
1013     foreach $suite (@suite_list) {
1014         my @test_dir_list = get_subdirs ($suite_path . $suite);
1015         my $test_dir;
1016
1017         foreach $test_dir (@test_dir_list) {
1018             my @test_list = get_js_files ($suite_path . $suite . $path_sep .
1019                                           $test_dir);
1020             my $test;
1021
1022             foreach $test (@test_list) {
1023                 $retval[$#retval + 1] = $suite . $path_sep . $test_dir .
1024                   $path_sep . $test;
1025             }
1026         }
1027     }
1028
1029     return @retval;
1030
1031 }
1032
1033 #
1034 # generate an output file name based on the date
1035 #
1036 sub get_tempfile_name {
1037     my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
1038       &get_padded_time (localtime);
1039     my $rv;
1040
1041     if ($os_type ne "MAC") {
1042         $rv = "results-" . $year . "-" . $mon . "-" . $mday . "-" . $hour .
1043           $min . $sec . "-" . $opt_engine_type;
1044     } else {
1045         $rv = "res-" . $year . $mon . $mday . $hour . $min . $sec . "-" .
1046           $opt_engine_type
1047     }
1048
1049     return $rv . ".html";
1050 }
1051
1052 sub get_padded_time {
1053     my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = @_;
1054
1055     $mon++;
1056     $mon = &zero_pad($mon);
1057     $year += 1900;
1058     $mday= &zero_pad($mday);
1059     $sec = &zero_pad($sec);
1060     $min = &zero_pad($min);
1061     $hour = &zero_pad($hour);
1062
1063     return ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst);
1064
1065 }
1066
1067 sub zero_pad {
1068     my ($string) = @_;
1069
1070     $string = ($string < 10) ? "0" . $string : $string;
1071     return $string;
1072 }
1073
1074 sub subtract_arrays {
1075     my ($whole_ref, $part_ref) = @_;
1076     my @whole = @$whole_ref;
1077     my @part = @$part_ref;
1078     my $line;
1079
1080     foreach $line (@part) {
1081         @whole = grep (!/$line/, @whole);
1082     }
1083
1084     return @whole;
1085
1086 }
1087
1088 #
1089 # Convert unix path to mac style.
1090 #
1091 sub unix_to_mac {
1092     my ($path) = @_;
1093     my @path_elements = split ("/", $path);
1094     my $rv = "";
1095     my $i;
1096
1097     foreach $i (0 .. $#path_elements) {
1098         if ($path_elements[$i] eq ".") {
1099             if (!($rv =~ /\:$/)) {
1100                 $rv .= ":";
1101             }
1102         } elsif ($path_elements[$i] eq "..") {
1103             if (!($rv =~ /\:$/)) {
1104                 $rv .= "::";
1105             } else {
1106                 $rv .= ":";
1107             }
1108         } elsif ($path_elements[$i] ne "") {
1109             $rv .= $path_elements[$i] . ":";
1110         }
1111
1112     }
1113
1114     $rv =~ s/\:$//;
1115
1116     return $rv;
1117 }
1118
1119 #
1120 # Convert unix path to win style.
1121 #
1122 sub unix_to_win {
1123   my ($path) = @_;
1124
1125   if ($path_sep ne $win_sep) {
1126       $path =~ s/$path_sep/$win_sep/g;
1127   }
1128
1129   return $path;
1130 }
1131
1132 #
1133 # Windows shells require "/" or "\" as path separator.
1134 # Find out the one used in the current Windows shell.
1135 #
1136 sub get_win_sep {
1137   my $path = $ENV{"PATH"} || $ENV{"Path"} || $ENV{"path"};
1138   $path =~ /\\|\//;
1139   return $&;
1140 }
1141
1142 #
1143 # Convert unix path to correct style based on platform.
1144 #
1145 sub xp_path {
1146     my ($path) = @_;
1147
1148     if ($os_type eq "MAC") {
1149         return &unix_to_mac($path);
1150     } elsif($os_type eq "WIN") {
1151         return &unix_to_win($path);
1152     } else {
1153         return $path;
1154     }
1155 }
1156
1157 #
1158 # given a directory, return an array of all subdirectories
1159 #
1160 sub get_subdirs {
1161     my ($dir)  = @_;
1162     my @subdirs;
1163
1164     if ($os_type ne "MAC") {
1165         if (!($dir =~ /\/$/)) {
1166             $dir = $dir . "/";
1167         }
1168     } else {
1169         if (!($dir =~ /\:$/)) {
1170             $dir = $dir . ":";
1171         }
1172     }
1173     opendir (DIR, $dir) || die ("couldn't open directory $dir: $!");
1174     my @testdir_contents = readdir(DIR);
1175     closedir(DIR);
1176
1177     foreach (@testdir_contents) {
1178         if ((-d ($dir . $_)) && ($_ ne 'CVS') && ($_ ne '.') && ($_ ne '..')) {
1179             @subdirs[$#subdirs + 1] = $_;
1180         }
1181     }
1182
1183     return @subdirs;
1184 }
1185
1186 #
1187 # given a directory, return an array of all the js files that are in it.
1188 #
1189 sub get_js_files {
1190     my ($test_subdir) = @_;
1191     my (@js_file_array, @subdir_files);
1192
1193     opendir (TEST_SUBDIR, $test_subdir) || die ("couldn't open directory " .
1194                                                 "$test_subdir: $!");
1195     @subdir_files = readdir(TEST_SUBDIR);
1196     closedir( TEST_SUBDIR );
1197
1198     foreach (@subdir_files) {
1199         if ($_ =~ /\.js$/) {
1200             $js_file_array[$#js_file_array+1] = $_;
1201         }
1202     }
1203
1204     return @js_file_array;
1205 }
1206
1207 sub report_failure {
1208     my ($test, $message, $bug_number) = @_;
1209     my $bug_line = "";
1210
1211     $failures_reported++;
1212
1213     $message =~ s/\n+/\n/g;
1214     $test =~ s/\:/\//g;
1215
1216     if ($opt_console_failures) {
1217         if($bug_number) {
1218             print STDERR ("*-* Testcase $test failed:\nBug Number $bug_number".
1219                           "\n$message\n");
1220         } else {
1221             print STDERR ("*-* Testcase $test failed:\n$message\n");
1222         }
1223     }
1224
1225     $message =~ s/\n/<br>\n/g;
1226     $html .= "<a name='failure$failures_reported'></a>";
1227
1228     if ($bug_number) {
1229         $bug_line = "<a href='$opt_bug_url$bug_number' target='other_window'>".
1230                     "Bug Number $bug_number</a>";
1231     }
1232
1233     if ($opt_lxr_url) {
1234         $test =~ /\/?([^\/]+\/[^\/]+\/[^\/]+)$/;
1235         $test = $1;
1236         $html .= "<dd><b>".
1237           "Testcase <a target='other_window' href='$opt_lxr_url$test'>$1</a> " .
1238             "failed</b> $bug_line<br>\n";
1239     } else {
1240         $html .= "<dd><b>".
1241           "Testcase $test failed</b> $bug_line<br>\n";
1242     }
1243
1244     $html .= " [ ";
1245     if ($failures_reported > 1) {
1246         $html .= "<a href='#failure" . ($failures_reported - 1) . "'>" .
1247           "Previous Failure</a> | ";
1248     }
1249
1250     $html .= "<a href='#failure" . ($failures_reported + 1) . "'>" .
1251       "Next Failure</a> | " .
1252         "<a href='#tippy_top'>Top of Page</a> ]<br>\n" .
1253           "<tt>$message</tt><br>\n";
1254
1255     @failed_tests[$#failed_tests + 1] = $test;
1256
1257 }
1258
1259 sub dd {
1260
1261     if ($opt_trace) {
1262         print ("-*- ", @_ , "\n");
1263     }
1264
1265 }
1266
1267 sub status {
1268
1269     print ("-#- ", @_ , "\n");
1270
1271 }
1272
1273 sub int_handler {
1274     my $resp;
1275
1276     do {
1277         print ("\n*** User Break: Just [Q]uit, Quit and [R]eport, [C]ontinue ?");
1278         $resp = <STDIN>;
1279     } until ($resp =~ /[QqRrCc]/);
1280
1281     if ($resp =~ /[Qq]/) {
1282         print ("User Exit.  No results were generated.\n");
1283         exit;
1284     } elsif ($resp =~ /[Rr]/) {
1285         $user_exit = 1;
1286     }
1287
1288 }