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 32use strict; 33use FindBin; 34use Getopt::Long qw(:config pass_through); 35use lib $FindBin::Bin; 36use webkitdirs; 37use POSIX; 38 39# determine configuration 40setConfiguration(); 41my $configuration = configuration(); 42 43my @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 56my $jsDriverArgs = "-L " . join(" ", @testsToSkip); 57my $root; # intentionally left undefined 58my $skipBuild = 0; 59my $showHelp = 0; 60 61my $programName = basename($0); 62my $usage = <<EOF; 63Usage: $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 67EOF 68 69GetOptions( 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 77my @buildArgs = @ARGV; 78 79# Arguments passed to --jsDriver-args (if any) are passed to jsDriver.pl 80my @jsArgs = split(" ", $jsDriverArgs); 81 82if ($showHelp) { 83 print STDERR $usage; 84 exit 1; 85} 86 87setConfigurationProductDir(Cwd::abs_path($root)) if (defined($root)); 88 89if (!defined($root) && !$skipBuild) { 90 chdirWebKit(); 91 92 push(@buildArgs, argumentsForConfiguration()); 93 94 print "Running: build-jsc " . join(" ", @buildArgs) . "\n"; 95 my $buildResult = system "perl", "Tools/Scripts/build-jsc", @buildArgs; 96 if ($buildResult) { 97 print STDERR "Compiling jsc failed!\n"; 98 exit exitStatus($buildResult); 99 } 100} 101 102 103my $productDir = jscProductDir(); 104$ENV{DYLD_FRAMEWORK_PATH} = $productDir; 105setPathForRunningWebKitApp(\%ENV) if isCygwin(); 106 107sub testapiPath($) 108{ 109 my ($productDir) = @_; 110 my $jscName = "testapi"; 111 $jscName .= "_debug" if configurationForVisualStudio() eq "Debug_All"; 112 return "$productDir/$jscName"; 113} 114 115#run api tests 116if (isAppleMacWebKit() || isAppleWinWebKit()) { 117 chdirWebKit(); 118 chdir($productDir) or die; 119 my $path = testapiPath($productDir); 120 # Use an "indirect object" so that system() won't get confused if the path 121 # contains spaces (see perldoc -f exec). 122 my $testapiResult = system { $path } $path; 123 exit exitStatus($testapiResult) if $testapiResult; 124} 125 126# Find JavaScriptCore directory 127chdirWebKit(); 128chdir("Source/JavaScriptCore"); 129chdir "tests/mozilla" or die; 130printf "Running: jsDriver.pl -e squirrelfish -s %s -f actual.html %s\n", jscPath($productDir), join(" ", @jsArgs); 131my $result = system "perl", "jsDriver.pl", "-e", "squirrelfish", "-s", jscPath($productDir), "-f", "actual.html", @jsArgs; 132exit exitStatus($result) if $result; 133 134my %failures; 135 136open EXPECTED, "expected.html" or die; 137while (<EXPECTED>) { 138 last if /failures reported\.$/; 139} 140while (<EXPECTED>) { 141 chomp; 142 $failures{$_} = 1; 143} 144close EXPECTED; 145 146my %newFailures; 147 148open ACTUAL, "actual.html" or die; 149while (<ACTUAL>) { 150 last if /failures reported\.$/; 151} 152while (<ACTUAL>) { 153 chomp; 154 if ($failures{$_}) { 155 delete $failures{$_}; 156 } else { 157 $newFailures{$_} = 1; 158 } 159} 160close ACTUAL; 161 162my $numNewFailures = keys %newFailures; 163if ($numNewFailures) { 164 print "\n** Danger, Will Robinson! Danger! The following failures have been introduced:\n"; 165 foreach my $failure (sort keys %newFailures) { 166 print "\t$failure\n"; 167 } 168} 169 170my $numOldFailures = keys %failures; 171if ($numOldFailures) { 172 print "\nYou fixed the following test"; 173 print "s" if $numOldFailures != 1; 174 print ":\n"; 175 foreach my $failure (sort keys %failures) { 176 print "\t$failure\n"; 177 } 178} 179 180print "\n"; 181 182print "$numNewFailures regression"; 183print "s" if $numNewFailures != 1; 184print " found.\n"; 185 186print "$numOldFailures test"; 187print "s" if $numOldFailures != 1; 188print " fixed.\n"; 189 190print "OK.\n" if $numNewFailures == 0; 191exit(1) if $numNewFailures; 192