run-webkit-tests

linux下开源浏览器WebKit的源码,市面上的很多商用浏览器都是移植自WebKit

{
    my ($path) = @_;

    my $pathSeparator = "/";
    my $dirname = dirname($path) . $pathSeparator;
    $dirname = "" if $dirname eq "." . $pathSeparator;

    return ($dirname, basename($path));
}

# Sort first by directory, then by file, so all paths in one directory are grouped
# rather than being interspersed with items from subdirectories.
# Use numericcmp to sort directory and filenames to make order logical.
sub pathcmp($$)
{
    my ($patha, $pathb) = @_;

    my ($dira, $namea) = splitpath($patha);
    my ($dirb, $nameb) = splitpath($pathb);

    return numericcmp($dira, $dirb) if $dira ne $dirb;
    return numericcmp($namea, $nameb);
}

# Sort numeric parts of strings as numbers, other parts as strings.
# Makes 1.33 come after 1.3, which is cool.
sub numericcmp($$)
{
    my ($aa, $bb) = @_;

    my @a = split /(\d+)/, $aa;
    my @b = split /(\d+)/, $bb;

    # Compare one chunk at a time.
    # Each chunk is either all numeric digits, or all not numeric digits.
    while (@a && @b) {
        my $a = shift @a;
        my $b = shift @b;
        
        # Use numeric comparison if chunks are non-equal numbers.
        return $a <=> $b if $a =~ /^\d/ && $b =~ /^\d/ && $a != $b;

        # Use string comparison if chunks are any other kind of non-equal string.
        return $a cmp $b if $a ne $b;
    }
    
    # One of the two is now empty; compare lengths for result in this case.
    return @a <=> @b;
}

# Sort slowest tests first.
sub slowestcmp($$)
{
    my ($testa, $testb) = @_;

    my $dura = $durations{$testa};
    my $durb = $durations{$testb};
    return $durb <=> $dura if $dura != $durb;
    return pathcmp($testa, $testb);
}

sub openDumpTool()
{
    return if $isDumpToolOpen;

    # Save some requires variables for the linux environment...
    my $homeDir = $ENV{'HOME'};
    my $libraryPath = $ENV{'LD_LIBRARY_PATH'};
    my $dyldLibraryPath = $ENV{'DYLD_LIBRARY_PATH'};
    my $dbusAddress = $ENV{'DBUS_SESSION_BUS_ADDRESS'};
    my $display = $ENV{'DISPLAY'};
    my $testfonts = $ENV{'WEBKIT_TESTFONTS'};

    my $homeDrive = $ENV{'HOMEDRIVE'};
    my $homePath = $ENV{'HOMEPATH'};
        
    local %ENV;
    if (isQt() || isGtk()) {
        if (defined $display) {
            $ENV{DISPLAY} = $display;
        } else {
            $ENV{DISPLAY} = ":1";
        }
        $ENV{'WEBKIT_TESTFONTS'} = $testfonts if defined($testfonts);
        $ENV{HOME} = $homeDir;
        if (defined $libraryPath) {
            $ENV{LD_LIBRARY_PATH} = $libraryPath;
        }
        if (defined $dyldLibraryPath) {
            $ENV{DYLD_LIBRARY_PATH} = $dyldLibraryPath;
        }
        if (defined $dbusAddress) {
            $ENV{DBUS_SESSION_BUS_ADDRESS} = $dbusAddress;
        }
    }
    $ENV{DYLD_FRAMEWORK_PATH} = $productDir;
    $ENV{XML_CATALOG_FILES} = ""; # work around missing /etc/catalog <rdar://problem/4292995>
    $ENV{DYLD_INSERT_LIBRARIES} = "/usr/lib/libgmalloc.dylib" if $guardMalloc;
    
    if (isCygwin()) {
        $ENV{HOMEDRIVE} = $homeDrive;
        $ENV{HOMEPATH} = $homePath;
        if ($testfonts) {
            $ENV{WEBKIT_TESTFONTS} = $testfonts;
        }
        setPathForRunningWebKitApp(\%ENV) if isCygwin();
    }

    exportArchPreference();

    my @args = @toolArgs;
    unshift @args, $dumpTool;
    if (isAppleMacWebKit and !isTiger()) {
        unshift @args, "arch";
    }
    if ($useValgrind) {
        unshift @args, "valgrind";
    } 
    
    $ENV{MallocStackLogging} = 1 if $shouldCheckLeaks;
    $dumpToolPID = open3(\*OUT, \*IN, \*ERROR, @args) or die "Failed to start tool: $dumpTool\n";
    $ENV{MallocStackLogging} = 0 if $shouldCheckLeaks;
    $isDumpToolOpen = 1;
    $dumpToolCrashed = 0;
}

sub closeDumpTool()
{
    return if !$isDumpToolOpen;

    close IN;
    close OUT;
    waitpid $dumpToolPID, 0;
    
    # check for WebCore counter leaks.
    if ($shouldCheckLeaks) {
        while (<ERROR>) {
            print;
        }
    }
    close ERROR;
    $isDumpToolOpen = 0;
}

sub dumpToolDidCrash()
{
    return 1 if $dumpToolCrashed;
    return 0 unless $isDumpToolOpen;

    my $pid = waitpid(-1, WNOHANG);
    return 1 if ($pid == $dumpToolPID);

    # On Mac OS X, crashing may be significantly delayed by crash reporter.
    return 0 unless isAppleMacWebKit();

    my $tryingToExit = 0;
    open PS, "ps -o state -p $dumpToolPID |";
    <PS>; # skip header
    $tryingToExit = 1 if <PS> =~ /E/;
    close PS;
    return $tryingToExit;
}

sub openHTTPDIfNeeded()
{
    return if $isHttpdOpen;

    mkdir "/tmp/WebKit";
    
    if (-f "/tmp/WebKit/httpd.pid") {
        my $oldPid = `cat /tmp/WebKit/httpd.pid`;
        chomp $oldPid;
        if (0 != kill 0, $oldPid) {
            print "\nhttpd is already running: pid $oldPid, killing...\n";
            kill 15, $oldPid;
            
            my $retryCount = 20;
            while ((0 != kill 0, $oldPid) && $retryCount) {
                sleep 1;
                --$retryCount;
            }
            
            die "Timed out waiting for httpd to quit" unless $retryCount;
        }
    }
    
    my $httpdPath = "/usr/sbin/httpd";
    my $httpdConfig;
    if (isCygwin()) {
        my $windowsConfDirectory = "$testDirectory/http/conf/";
        unless (-x "/usr/lib/apache/libphp4.dll") {
            copy("$windowsConfDirectory/libphp4.dll", "/usr/lib/apache/libphp4.dll");
            chmod(0755, "/usr/lib/apache/libphp4.dll");
        }
        $httpdConfig = "$windowsConfDirectory/cygwin-httpd.conf";
    } elsif (isDebianBased()) {
        $httpdPath = "/usr/sbin/apache2";
        $httpdConfig = "$testDirectory/http/conf/apache2-debian-httpd.conf";
    } else {
        $httpdConfig = "$testDirectory/http/conf/httpd.conf";
        $httpdConfig = "$testDirectory/http/conf/apache2-httpd.conf" if `$httpdPath -v` =~ m|Apache/2|;
    }
    my $documentRoot = "$testDirectory/http/tests";
    my $typesConfig = "$testDirectory/http/conf/mime.types";
    my $listen = "127.0.0.1:$httpdPort";
    my $absTestResultsDirectory = File::Spec->rel2abs(glob $testResultsDirectory);
    my $sslCertificate = "$testDirectory/http/conf/webkit-httpd.pem";

    mkpath $absTestResultsDirectory;

    my @args = (
        "-f", "$httpdConfig",
        "-C", "DocumentRoot \"$documentRoot\"",
        "-C", "Listen $listen",
        "-c", "TypesConfig \"$typesConfig\"",
        "-c", "CustomLog \"$absTestResultsDirectory/access_log.txt\" common",
        "-c", "ErrorLog \"$absTestResultsDirectory/error_log.txt\"",
        # Apache wouldn't run CGIs with permissions==700 otherwise
        "-c", "User \"#$<\""
    );

    # FIXME: Enable this on Windows once <rdar://problem/5345985> is fixed
    # The version of Apache we use with Cygwin does not support SSL
    push(@args, "-c", "SSLCertificateFile \"$sslCertificate\"") unless isCygwin();

    open2(\*HTTPDIN, \*HTTPDOUT, $httpdPath, @args);

    my $retryCount = 20;
    while (system("/usr/bin/curl -q --silent --stderr - --output /dev/null $listen") && $retryCount) {
        sleep 1;
        --$retryCount;
    }
    
    die "Timed out waiting for httpd to start" unless $retryCount;
    
    $isHttpdOpen = 1;
}

sub closeHTTPD()
{
    return if !$isHttpdOpen;

    close HTTPDIN;
    close HTTPDOUT;

    kill 15, `cat /tmp/WebKit/httpd.pid` if -f "/tmp/WebKit/httpd.pid";

    $isHttpdOpen = 0;
}

sub fileNameWithNumber($$)
{
    my ($base, $number) = @_;
    return "$base$number" if ($number > 1);
    return $base;
}

sub processIgnoreTests($$) {
    my @ignoreList = split(/\s*,\s*/, shift);
    my $listName = shift;

    my $disabledSuffix = "-disabled";

    my $addIgnoredDirectories = sub {
        return () if exists $ignoredLocalDirectories{basename($File::Find::dir)};
        $ignoredDirectories{File::Spec->abs2rel($File::Find::dir, $testDirectory)} = 1;
        return @_;
    };
    foreach my $item (@ignoreList) {
        my $path = catfile($testDirectory, $item); 
        if (-d $path) {
            $ignoredDirectories{$item} = 1;
            find({ preprocess => $addIgnoredDirectories, wanted => sub {} }, $path);
        }
        elsif (-f $path) {
            $ignoredFiles{$item} = 1;
        } elsif (-f $path . $disabledSuffix) {
            # The test is disabled, so do nothing.
        } else {
            print "$listName list contained '$item', but no file of that name could be found\n";
        }
    }
}

sub stripExtension($)
{
    my ($test) = @_;

    $test =~ s/\.[a-zA-Z]+$//;
    return $test;
}

sub isTextOnlyTest($)
{
    my ($actual) = @_;
    my $isText;
    if ($actual =~ /^layer at/ms) {
        $isText = 0;
    } else {
        $isText = 1;
    }
    return $isText;
}

sub expectedDirectoryForTest($;$;$)
{
    my ($base, $isText, $expectedExtension) = @_;

    my @directories = @platformHierarchy;
    push @directories, map { catdir($platformBaseDirectory, $_) } qw(mac-leopard mac) if isCygwin();
    push @directories, $expectedDirectory;

    # If we already have expected results, just return their location.
    foreach my $directory (@directories) {
        return $directory if (-f "$directory/$base-$expectedTag.$expectedExtension");
    }

    # For platform-specific tests, the results should go right next to the test itself.
    # Note: The return value of this subroutine will be concatenated with $base
    # to determine the location of the new results, so returning $expectedDirectory
    # will put the results right next to the test.
    # FIXME: We want to allow platform/mac tests with platform/mac-leopard results,
    # so this needs to be enhanced.
    return $expectedDirectory if $base =~ /^platform/;

    # For cross-platform tests, text-only results should go in the cross-platform directory,
    # while render tree dumps should go in the least-specific platform directory.
    return $isText ? $expectedDirectory : $platformHierarchy[$#platformHierarchy];
}

sub countFinishedTest($$$$) {
    my ($test, $base, $result, $isText) = @_;

    if (($count + 1) % $testsPerDumpTool == 0 || $count == $#tests) {
        if ($shouldCheckLeaks) {
            my $fileName;
            if ($testsPerDumpTool == 1) {
                $fileName = "$testResultsDirectory/$base-leaks.txt";
            } else {
                $fileName = "$testResultsDirectory/" . fileNameWithNumber($dumpToolName, $leaksOutputFileNumber) . "-leaks.txt";
            }
            my $leakCount = countAndPrintLeaks($dumpToolName, $dumpToolPID, $fileName);
            $totalLeaks += $leakCount;
            $leaksOutputFileNumber++ if ($leakCount);
        }

        closeDumpTool();
    }
    
    $count++;
    $counts{$result}++;
    push @{$tests{$result}}, $test;
    $testType{$test} = $isText;
}

sub testCrashedOrTimedOut($$$$$)
{
    my ($test, $base, $didCrash, $actual, $error) = @_;

    printFailureMessageForTest($test, $didCrash ? "crashed" : "timed out");

    sampleDumpTool() unless $didCrash;

    my $dir = "$testResultsDirectory/$base";
    $dir =~ s|/([^/]+)$|| or die "Failed to find test name from base\n";
    mkpath $dir;

    deleteExpectedAndActualResults($base);

    if (defined($error) && length($error)) {
        writeToFile("$testResultsDirectory/$base-$errorTag.txt", $error);
    }

    recordActualResultsAndDiff($base, $actual);

    kill 9, $dumpToolPID unless $didCrash;

    closeDumpTool();
}