Home | History | Annotate | Download | only in Scripts 
      1 #!/usr/bin/perl -w
      2 
      3 # Copyright (C) 2005 Apple Computer, Inc.  All rights reserved.
      4 # Copyright (C) 2007 Eric Seidel <eric (at] 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;
    189