1 files changed, 246 insertions, 0 deletions
diff --git a/Tools/Scripts/run-api-tests b/Tools/Scripts/run-api-tests
new file mode 100755
index 0000000..29430a8
--- /dev/null
+++ b/Tools/Scripts/run-api-tests
@@ -0,0 +1,246 @@
+#!/usr/bin/perl -w
+
+# Copyright (C) 2010 Apple Inc. All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+# 1. Redistributions of source code must retain the above copyright
+#    notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+#    notice, this list of conditions and the following disclaimer in the
+#    documentation and/or other materials provided with the distribution.
+#
+# THIS SOFTWARE IS PROVIDED BY APPLE INC. AND ITS CONTRIBUTORS ``AS IS''
+# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
+# THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+# PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL APPLE INC. OR ITS CONTRIBUTORS
+# BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+# THE POSSIBILITY OF SUCH DAMAGE.
+
+# Features to add:
+#   - Command line option to run a single test.
+#   - Command line option to run all tests in a suite.
+
+use strict;
+use warnings;
+
+use File::Basename;
+use FindBin;
+use Getopt::Long qw(:config pass_through);
+use IPC::Open3;
+use lib $FindBin::Bin;
+use webkitdirs;
+use Term::ANSIColor qw(:constants);
+
+sub dumpAllTests();
+sub runAllTests();
+sub runAllTestsInSuite($);
+sub runTest($$);
+sub populateTests();
+sub buildTestTool();
+
+my $showHelp = 0;
+my $quiet = 0;
+my $dump = 0;
+
+my $programName = basename($0);
+my $usage = <<EOF;
+Usage: $programName [options]
+  --help                Show this help message
+  -q|--quite            Less verbose output
+  -d|--dump-tests       Dump the names of testcases without running them
+EOF
+
+GetOptions(
+    'help' => \$showHelp,
+    'quiet|q' => \$quiet,
+    'dump|d' => \$dump,
+);
+
+if ($showHelp) {
+   print STDERR $usage;
+   exit 1;
+}
+
+setConfiguration();
+buildTestTool();
+setPathForRunningWebKitApp(\%ENV);
+my %testsToRun = populateTests();
+
+if ($dump) {
+    dumpAllTests();
+    exit 0;
+}
+
+runAllTests();
+
+sub dumpAllTests()
+{
+    print "Dumping test cases\n";
+    print "------------------\n";
+    for my $suite (keys %testsToRun) {
+        print $suite . ":\n";
+        print map { "    " . $_ . "\n" } @{ $testsToRun{$suite} };
+    }
+    print "------------------\n";
+}
+
+sub runAllTests()
+{
+    my $anyFailures = 0;
+    for my $suite (keys %testsToRun) {
+        my $failed = runAllTestsInSuite($suite);
+        if ($failed) {
+            $anyFailures = 1;
+        }
+    }
+    return $anyFailures;
+}
+
+sub runAllTestsInSuite($)
+{
+    my ($suite) = @_;
+    print "Suite: $suite\n";
+
+    my $anyFailures = 0;
+    for my $test (@{$testsToRun{$suite}}) {
+        my $failed = runTest($suite, $test);
+        if ($failed) {
+            $anyFailures = 1;
+        }
+    }
+    
+    return $anyFailures;
+}
+
+sub runTest($$)
+{
+    my ($suite, $testName) = @_;
+    my $test = $suite . "/" . $testName;
+
+    print "    Test: $testName -> ";
+
+    my $result = 0;
+    if (isAppleMacWebKit()) {
+        my $productDir = productDir();
+        $ENV{DYLD_FRAMEWORK_PATH} = $productDir;
+        $ENV{WEBKIT_UNSET_DYLD_FRAMEWORK_PATH} = "YES";
+        my $apiTesterPath = "$productDir/TestWebKitAPI";
+        if (architecture()) {
+            $result = system "arch", "-" . architecture(), $apiTesterPath, $test, @ARGV;
+        } else {
+            $result = system $apiTesterPath, $test, @ARGV;
+        }
+    } elsif (isAppleWinWebKit()) {
+        my $apiTesterNameSuffix;
+        if (configurationForVisualStudio() ne "Debug_All") {
+            $apiTesterNameSuffix = "";
+        } else {
+            $apiTesterNameSuffix = "_debug";
+        }
+        my $apiTesterPath = File::Spec->catfile(productDir(), "TestWebKitAPI$apiTesterNameSuffix.exe");
+        $result = system $apiTesterPath, $test, @ARGV;
+    } else {
+        die "run-api-tests is not supported on this platform.\n"
+    }
+    
+    if ($result == 0) {
+        print BOLD GREEN, "Passed", RESET, "\n";
+    } else {
+        print BOLD RED, "Failed", RESET, "\n";
+    }
+}
+
+
+sub populateTests()
+{
+    my @tests;
+
+    if (isAppleMacWebKit()) {
+        my $productDir = productDir();
+        $ENV{DYLD_FRAMEWORK_PATH} = $productDir;
+        $ENV{WEBKIT_UNSET_DYLD_FRAMEWORK_PATH} = "YES";
+        my $apiTesterPath = "$productDir/TestWebKitAPI";
+
+        my ($pid, $childIn, $childOut);
+        if (architecture()) {
+            $pid = open3($childIn, $childOut, ">&STDERR", "arch", "-" . architecture(), $apiTesterPath, "--dump-tests") or die "Failed to build list of tests!";
+        } else {
+            $pid = open3($childIn, $childOut, ">&STDERR", $apiTesterPath, "--dump-tests") or die "Failed to build list of tests!";
+        }
+        close($childIn);
+        @tests = <$childOut>;
+        close($childOut);
+
+        waitpid($pid, 0);
+        my $result = $?;
+
+        if ($result) {
+            print STDERR "Failed to build list of tests!\n";
+            exit exitStatus($result);
+        }
+    } elsif (isAppleWinWebKit()) {
+        my $apiTesterNameSuffix;
+        if (configurationForVisualStudio() ne "Debug_All") {
+            $apiTesterNameSuffix = "";
+        } else {
+            $apiTesterNameSuffix = "_debug";
+        }
+        my $apiTesterPath = File::Spec->catfile(productDir(), "TestWebKitAPI$apiTesterNameSuffix.exe");
+        open(TESTS, "-|", $apiTesterPath, "--dump-tests") or die $!;
+        @tests = <TESTS>;
+        close(TESTS) or die $!;
+    } else {
+        die "run-api-tests is not supported on this platform.\n"
+    }
+
+    my %keyedTests = ();
+    for my $test (@tests) {
+        $test =~ s/[\r\n]*$//;
+        my ($suite, $testName) = split(/\//, $test);
+        push @{$keyedTests{$suite}}, $testName;
+    }
+    
+    return %keyedTests;
+}
+
+sub buildTestTool()
+{
+    chdirWebKit();
+
+    my $buildTestTool = "build-api-tests";
+    print STDERR "Running $buildTestTool\n";
+
+    local *DEVNULL;
+    my ($childIn, $childOut, $childErr);
+    if ($quiet) {
+        open(DEVNULL, ">", File::Spec->devnull()) or die "Failed to open /dev/null";
+        $childOut = ">&DEVNULL";
+        $childErr = ">&DEVNULL";
+    } else {
+        # When not quiet, let the child use our stdout/stderr.
+        $childOut = ">&STDOUT";
+        $childErr = ">&STDERR";
+    }
+
+    my @args = argumentsForConfiguration();
+    my $buildProcess = open3($childIn, $childOut, $childErr, "Tools/Scripts/$buildTestTool", @args) or die "Failed to run " . $buildTestTool;
+    close($childIn);
+    waitpid $buildProcess, 0;
+    my $buildResult = $?;
+    close($childOut);
+    close($childErr);
+
+    close DEVNULL if ($quiet);
+
+    if ($buildResult) {
+        print STDERR "Compiling TestWebKitAPI failed!\n";
+        exit exitStatus($buildResult);
+    }
+}