|
1 #!/usr/bin/perl -w |
|
2 |
|
3 # Copyright (C) 2005 Apple Computer, Inc. All rights reserved. |
|
4 # Copyright (C) 2007 Eric Seidel <eric@webkit.org> |
|
5 # |
|
6 # Redistribution and use in source and binary forms, with or without |
|
7 # modification, are permitted provided that the following conditions |
|
8 # are met: |
|
9 # |
|
10 # 1. Redistributions of source code must retain the above copyright |
|
11 # notice, this list of conditions and the following disclaimer. |
|
12 # 2. Redistributions in binary form must reproduce the above copyright |
|
13 # notice, this list of conditions and the following disclaimer in the |
|
14 # documentation and/or other materials provided with the distribution. |
|
15 # 3. Neither the name of Apple Computer, Inc. ("Apple") nor the names of |
|
16 # its contributors may be used to endorse or promote products derived |
|
17 # from this software without specific prior written permission. |
|
18 # |
|
19 # THIS SOFTWARE IS PROVIDED BY APPLE AND ITS CONTRIBUTORS "AS IS" AND ANY |
|
20 # EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED |
|
21 # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE |
|
22 # DISCLAIMED. IN NO EVENT SHALL APPLE OR ITS CONTRIBUTORS BE LIABLE FOR ANY |
|
23 # DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES |
|
24 # (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; |
|
25 # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND |
|
26 # ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT |
|
27 # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF |
|
28 # THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |
|
29 |
|
30 # Script to run the WebKit Open Source Project JavaScriptCore tests (adapted from Mozilla). |
|
31 |
|
32 use strict; |
|
33 use FindBin; |
|
34 use Getopt::Long qw(:config pass_through); |
|
35 use lib $FindBin::Bin; |
|
36 use webkitdirs; |
|
37 use POSIX; |
|
38 |
|
39 # determine configuration |
|
40 setConfiguration(); |
|
41 my $configuration = configuration(); |
|
42 |
|
43 my @testsToSkip = ( |
|
44 # Various ecma/Date tests sometimes fail on Windows (but not Mac) https://bugs.webkit.org/show_bug.cgi?id=25160 |
|
45 "ecma/Date/15.9.2.1.js", |
|
46 "ecma/Date/15.9.2.2-1.js", |
|
47 "ecma/Date/15.9.2.2-2.js", |
|
48 "ecma/Date/15.9.2.2-3.js", |
|
49 "ecma/Date/15.9.2.2-4.js", |
|
50 "ecma/Date/15.9.2.2-5.js", |
|
51 "ecma/Date/15.9.2.2-6.js", |
|
52 # ecma_3/Date/15.9.5.7.js fails on Mac (but not Windows) https://bugs.webkit.org/show_bug.cgi?id=25161 |
|
53 "ecma_3/Date/15.9.5.7.js", |
|
54 ); |
|
55 |
|
56 my $jsDriverArgs = "-L " . join(" ", @testsToSkip); |
|
57 my $root; # intentionally left undefined |
|
58 my $skipBuild = 0; |
|
59 my $showHelp = 0; |
|
60 |
|
61 my $programName = basename($0); |
|
62 my $usage = <<EOF; |
|
63 Usage: $programName [options] [options to pass to build system] |
|
64 --help Show this help message |
|
65 --jsDriver-args= A string of arguments to pass to jsDriver.pl |
|
66 --root= Path to pre-built root containing jsc |
|
67 EOF |
|
68 |
|
69 GetOptions( |
|
70 'j|jsDriver-args=s' => \$jsDriverArgs, |
|
71 'root=s' => \$root, |
|
72 'skip-build' => \$skipBuild, |
|
73 'help' => \$showHelp |
|
74 ); |
|
75 |
|
76 # Assume any arguments left over from GetOptions are assumed to be build arguments |
|
77 my @buildArgs = @ARGV; |
|
78 |
|
79 # Arguments passed to --jsDriver-args (if any) are passed to jsDriver.pl |
|
80 my @jsArgs = split(" ", $jsDriverArgs); |
|
81 |
|
82 if ($showHelp) { |
|
83 print STDERR $usage; |
|
84 exit 1; |
|
85 } |
|
86 |
|
87 setConfigurationProductDir(Cwd::abs_path($root)) if (defined($root)); |
|
88 |
|
89 if (!defined($root) && !$skipBuild) { |
|
90 chdirWebKit(); |
|
91 |
|
92 push(@buildArgs, argumentsForConfiguration()); |
|
93 |
|
94 print "Running: build-jsc " . join(" ", @buildArgs) . "\n"; |
|
95 my $buildResult = system "perl", "WebKitTools/Scripts/build-jsc", @buildArgs; |
|
96 if ($buildResult) { |
|
97 print STDERR "Compiling jsc failed!\n"; |
|
98 exit exitStatus($buildResult); |
|
99 } |
|
100 } |
|
101 |
|
102 |
|
103 my $productDir = jscProductDir(); |
|
104 $ENV{DYLD_FRAMEWORK_PATH} = $productDir; |
|
105 setPathForRunningWebKitApp(\%ENV) if isCygwin(); |
|
106 |
|
107 sub testapiPath($) |
|
108 { |
|
109 my ($productDir) = @_; |
|
110 my $jscName = "testapi"; |
|
111 $jscName .= "_debug" if (isCygwin() && ($configuration eq "Debug")); |
|
112 return "$productDir/$jscName"; |
|
113 } |
|
114 |
|
115 #run api tests |
|
116 if (isAppleMacWebKit() || isAppleWinWebKit()) { |
|
117 chdirWebKit(); |
|
118 chdir($productDir) or die; |
|
119 my $testapiResult = system testapiPath($productDir); |
|
120 exit exitStatus($testapiResult) if $testapiResult; |
|
121 } |
|
122 |
|
123 # Find JavaScriptCore directory |
|
124 chdirWebKit(); |
|
125 chdir("JavaScriptCore"); |
|
126 chdir "tests/mozilla" or die; |
|
127 printf "Running: jsDriver.pl -e squirrelfish -s %s -f actual.html %s\n", jscPath($productDir), join(" ", @jsArgs); |
|
128 my $result = system "perl", "jsDriver.pl", "-e", "squirrelfish", "-s", jscPath($productDir), "-f", "actual.html", @jsArgs; |
|
129 exit exitStatus($result) if $result; |
|
130 |
|
131 my %failures; |
|
132 |
|
133 open EXPECTED, "expected.html" or die; |
|
134 while (<EXPECTED>) { |
|
135 last if /failures reported\.$/; |
|
136 } |
|
137 while (<EXPECTED>) { |
|
138 chomp; |
|
139 $failures{$_} = 1; |
|
140 } |
|
141 close EXPECTED; |
|
142 |
|
143 my %newFailures; |
|
144 |
|
145 open ACTUAL, "actual.html" or die; |
|
146 while (<ACTUAL>) { |
|
147 last if /failures reported\.$/; |
|
148 } |
|
149 while (<ACTUAL>) { |
|
150 chomp; |
|
151 if ($failures{$_}) { |
|
152 delete $failures{$_}; |
|
153 } else { |
|
154 $newFailures{$_} = 1; |
|
155 } |
|
156 } |
|
157 close ACTUAL; |
|
158 |
|
159 my $numNewFailures = keys %newFailures; |
|
160 if ($numNewFailures) { |
|
161 print "\n** Danger, Will Robinson! Danger! The following failures have been introduced:\n"; |
|
162 foreach my $failure (sort keys %newFailures) { |
|
163 print "\t$failure\n"; |
|
164 } |
|
165 } |
|
166 |
|
167 my $numOldFailures = keys %failures; |
|
168 if ($numOldFailures) { |
|
169 print "\nYou fixed the following test"; |
|
170 print "s" if $numOldFailures != 1; |
|
171 print ":\n"; |
|
172 foreach my $failure (sort keys %failures) { |
|
173 print "\t$failure\n"; |
|
174 } |
|
175 } |
|
176 |
|
177 print "\n"; |
|
178 |
|
179 print "$numNewFailures regression"; |
|
180 print "s" if $numNewFailures != 1; |
|
181 print " found.\n"; |
|
182 |
|
183 print "$numOldFailures test"; |
|
184 print "s" if $numOldFailures != 1; |
|
185 print " fixed.\n"; |
|
186 |
|
187 print "OK.\n" if $numNewFailures == 0; |
|
188 exit(1) if $numNewFailures; |