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