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", "WebKitTools/Scripts/build-jsc", @buildArgs; 96 if ($buildResult) { 97 print STDERR "Compiling jsc failed!\n"; 98 exit exitStatus($buildResult); 99 } 100} 101 102 103my $productDir = productDir(); 104 105$productDir .= "/JavaScriptCore" if isQt(); 106$productDir .= "/Programs" if isGtk(); 107$ENV{DYLD_FRAMEWORK_PATH} = $productDir; 108setPathForRunningWebKitApp(\%ENV) if isCygwin(); 109 110sub jscPath($) 111{ 112 my ($productDir) = @_; 113 my $jscName = "jsc"; 114 $jscName .= "_debug" if (isCygwin() && ($configuration eq "Debug")); 115 return "$productDir/$jscName"; 116} 117 118sub testapiPath($) 119{ 120 my ($productDir) = @_; 121 my $jscName = "testapi"; 122 $jscName .= "_debug" if (isCygwin() && ($configuration eq "Debug")); 123 return "$productDir/$jscName"; 124} 125 126#run api tests 127if (isAppleMacWebKit()) { 128 chdirWebKit(); 129 chdir($productDir) or die; 130 my $testapiResult = system testapiPath($productDir); 131 exit exitStatus($testapiResult) if $testapiResult; 132} 133 134# Find JavaScriptCore directory 135chdirWebKit(); 136chdir("JavaScriptCore"); 137chdir "tests/mozilla" or die; 138printf "Running: jsDriver.pl -e squirrelfish -s %s -f actual.html %s\n", jscPath($productDir), join(" ", @jsArgs); 139my $result = system "perl", "jsDriver.pl", "-e", "squirrelfish", "-s", jscPath($productDir), "-f", "actual.html", @jsArgs; 140exit exitStatus($result) if $result; 141 142my %failures; 143 144open EXPECTED, "expected.html" or die; 145while (<EXPECTED>) { 146 last if /failures reported\.$/; 147} 148while (<EXPECTED>) { 149 chomp; 150 $failures{$_} = 1; 151} 152close EXPECTED; 153 154my %newFailures; 155 156open ACTUAL, "actual.html" or die; 157while (<ACTUAL>) { 158 last if /failures reported\.$/; 159} 160while (<ACTUAL>) { 161 chomp; 162 if ($failures{$_}) { 163 delete $failures{$_}; 164 } else { 165 $newFailures{$_} = 1; 166 } 167} 168close ACTUAL; 169 170my $numNewFailures = keys %newFailures; 171if ($numNewFailures) { 172 print "\n** Danger, Will Robinson! Danger! The following failures have been introduced:\n"; 173 foreach my $failure (sort keys %newFailures) { 174 print "\t$failure\n"; 175 } 176} 177 178my $numOldFailures = keys %failures; 179if ($numOldFailures) { 180 print "\nYou fixed the following test"; 181 print "s" if $numOldFailures != 1; 182 print ":\n"; 183 foreach my $failure (sort keys %failures) { 184 print "\t$failure\n"; 185 } 186} 187 188print "\n"; 189 190print "$numNewFailures regression"; 191print "s" if $numNewFailures != 1; 192print " found.\n"; 193 194print "$numOldFailures test"; 195print "s" if $numOldFailures != 1; 196print " fixed.\n"; 197 198print "OK.\n" if $numNewFailures == 0; 199exit(1) if $numNewFailures; 200