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", "Tools/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 configurationForVisualStudio() eq "Debug_All";
    112     return "$productDir/$jscName";
    113 }
    114 
    115 #run api tests
    116 if (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
    127 chdirWebKit();
    128 chdir("Source/JavaScriptCore");
    129 chdir "tests/mozilla" or die;
    130 printf "Running: jsDriver.pl -e squirrelfish -s %s -f actual.html %s\n", jscPath($productDir), join(" ", @jsArgs);
    131 my $result = system "perl", "jsDriver.pl", "-e", "squirrelfish", "-s", jscPath($productDir), "-f", "actual.html", @jsArgs;
    132 exit exitStatus($result)  if $result;
    133 
    134 my %failures;
    135 
    136 open EXPECTED, "expected.html" or die;
    137 while (<EXPECTED>) {
    138     last if /failures reported\.$/;
    139 }
    140 while (<EXPECTED>) {
    141     chomp;
    142     $failures{$_} = 1;
    143 }
    144 close EXPECTED;
    145 
    146 my %newFailures;
    147 
    148 open ACTUAL, "actual.html" or die;
    149 while (<ACTUAL>) {
    150     last if /failures reported\.$/;
    151 }
    152 while (<ACTUAL>) {
    153     chomp;
    154     if ($failures{$_}) {
    155         delete $failures{$_};
    156     } else {
    157         $newFailures{$_} = 1;
    158     }
    159 }
    160 close ACTUAL;
    161 
    162 my $numNewFailures = keys %newFailures;
    163 if ($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 
    170 my $numOldFailures = keys %failures;
    171 if ($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 
    180 print "\n";
    181 
    182 print "$numNewFailures regression";
    183 print "s" if $numNewFailures != 1;
    184 print " found.\n";
    185 
    186 print "$numOldFailures test";
    187 print "s" if $numOldFailures != 1;
    188 print " fixed.\n";
    189 
    190 print "OK.\n" if $numNewFailures == 0;
    191 exit(1)  if $numNewFailures;
    192