run-webkit-tests

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

sub printFailureMessageForTest($$)
{
    my ($test, $description) = @_;

    unless ($verbose) {
        print "\n" unless $atLineStart;
        print "$test -> ";
    }
    print "$description\n";
    $atLineStart = 1;
}

my %cygpaths = ();

sub openCygpathIfNeeded($)
{
    my ($options) = @_;

    return unless isCygwin();
    return $cygpaths{$options} if $cygpaths{$options} && $cygpaths{$options}->{"open"};

    local (*CYGPATHIN, *CYGPATHOUT);
    my $pid = open2(\*CYGPATHIN, \*CYGPATHOUT, "cygpath -f - $options");
    my $cygpath =  {
        "pid" => $pid,
        "in" => *CYGPATHIN,
        "out" => *CYGPATHOUT,
        "open" => 1
    };

    $cygpaths{$options} = $cygpath;

    return $cygpath;
}

sub closeCygpaths()
{
    return unless isCygwin();

    foreach my $cygpath (values(%cygpaths)) {
        close $cygpath->{"in"};
        close $cygpath->{"out"};
        waitpid($cygpath->{"pid"}, 0);
        $cygpath->{"open"} = 0;

    }
}

sub convertPathUsingCygpath($$)
{
    my ($path, $options) = @_;

    my $cygpath = openCygpathIfNeeded($options);
    local *inFH = $cygpath->{"in"};
    local *outFH = $cygpath->{"out"};
    print outFH $path . "\n";
    chomp(my $convertedPath = <inFH>);
    return $convertedPath;
}

sub toWindowsPath($)
{
    my ($path) = @_;
    return unless isCygwin();

    return convertPathUsingCygpath($path, "-w");
}

sub toURL($)
{
    my ($path) = @_;
    return $path unless isCygwin();
    
    return "file:///" . convertPathUsingCygpath($path, "-m");
}

sub validateSkippedArg($$;$)
{
    my ($option, $value, $value2) = @_;
    my %validSkippedValues = map { $_ => 1 } qw(default ignore only);
    $value = lc($value);
    die "Invalid argument '" . $value . "' for option $option" unless $validSkippedValues{$value};
    $treatSkipped = $value;
}

sub htmlForResultsSection(\@$&)
{
    my ($tests, $description, $linkGetter) = @_;

    my @html = ();
    return join("\n", @html) unless @{$tests};

    push @html, "<p>$description:</p>";
    push @html, "<table>";
    foreach my $test (@{$tests}) {
        push @html, "<tr>";
        push @html, "<td><a href=\"" . toURL("$testDirectory/$test") . "\">$test</a></td>";
        foreach my $link (@{&{$linkGetter}($test)}) {
            push @html, "<td><a href=\"$link->{href}\">$link->{text}</a></td>";
        }
        push @html, "</tr>";
    }
    push @html, "</table>";

    return join("\n", @html);
}

sub linksForExpectedAndActualResults($)
{
    my ($base) = @_;

    my @links = ();

    return \@links unless -s "$testResultsDirectory/$base-$diffsTag.txt";
    
    my $expectedResultPath = $expectedResultPaths{$base};
    my ($expectedResultFileName, $expectedResultsDirectory, $expectedResultExtension) = fileparse($expectedResultPath, qr{\.[^.]+$});

    push @links, { href => "$base-$expectedTag$expectedResultExtension", text => "expected" };
    push @links, { href => "$base-$actualTag$expectedResultExtension", text => "actual" };
    push @links, { href => "$base-$diffsTag.txt", text => "diffs" };

    return \@links;
}

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

    my @links = ();

    my $base = stripExtension($test);

    push @links, @{linksForExpectedAndActualResults($base)};
    return \@links unless $pixelTests && $imagesPresent{$base};

    push @links, { href => "$base-$expectedTag.png", text => "expected image" };
    push @links, { href => "$base-$diffsTag.html", text => "image diffs" };
    push @links, { href => "$base-$diffsTag.png", text => "$imageDifferences{$base}%" };

    return \@links;
}

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

    my @links = ();

    my $base = stripExtension($test);

    push @links, @{linksForExpectedAndActualResults($base)};
    push @links, { href => "$base-$errorTag.txt", text => "stderr" };

    return \@links;
}

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

    my @links = ();

    my $base = stripExtension($test);
    my $expectedResultPath = $expectedResultPaths{$base};
    my $expectedResultPathMinusExtension = stripExtension($expectedResultPath);

    push @links, { href => toURL($expectedResultPath), text => "results" };
    if ($pixelTests && -f "$expectedResultPathMinusExtension.png") {
        push @links, { href => toURL("$expectedResultPathMinusExtension.png"), text => "image" };
    }

    return \@links;
}

sub deleteExpectedAndActualResults($)
{
    my ($base) = @_;

    unlink "$testResultsDirectory/$base-$actualTag.txt";
    unlink "$testResultsDirectory/$base-$diffsTag.txt";
    unlink "$testResultsDirectory/$base-$errorTag.txt";
}

sub recordActualResultsAndDiff($$)
{
    my ($base, $actualResults) = @_;

    return unless defined($actualResults) && length($actualResults);

    my $expectedResultPath = $expectedResultPaths{$base};
    my ($expectedResultFileNameMinusExtension, $expectedResultDirectoryPath, $expectedResultExtension) = fileparse($expectedResultPath, qr{\.[^.]+$});
    my $actualResultsPath = "$testResultsDirectory/$base-$actualTag$expectedResultExtension";
    my $copiedExpectedResultsPath = "$testResultsDirectory/$base-$expectedTag$expectedResultExtension";
    writeToFile("$actualResultsPath", $actualResults);
    copy("$expectedResultPath", "$copiedExpectedResultsPath");

    system "diff -u \"$copiedExpectedResultsPath\" \"$actualResultsPath\" > \"$testResultsDirectory/$base-$diffsTag.txt\"";
}

sub buildPlatformHierarchy()
{
    mkpath($platformTestDirectory) if ($platform eq "undefined" && !-d "$platformTestDirectory");

    my @platforms = split('-', $platform);
    my @hierarchy;
    for (my $i=0; $i < @platforms; $i++) {
        my $scoped = catdir($platformBaseDirectory, join('-', @platforms[0..($#platforms - $i)]));
        push(@hierarchy, $scoped) if (-d $scoped);
    }

    return @hierarchy;
}

sub epiloguesAndPrologues($$) {
    my ($lastDirectory, $directory) = @_;
    my @lastComponents = split('/', $lastDirectory);
    my @components = split('/', $directory);

    while (@lastComponents) {
        if (!defined($components[0]) || $lastComponents[0] ne $components[0]) {
            last;
        }
        shift @components;
        shift @lastComponents;
    }

    my @result;
    my $leaving = $lastDirectory;
    foreach (@lastComponents) {
        my $epilogue = $leaving . "/resources/run-webkit-tests-epilogue.html";
        foreach (@platformHierarchy) {
            push @result, catdir($_, $epilogue) if (stat(catdir($_, $epilogue)));
        }
        push @result, catdir($testDirectory, $epilogue) if (stat(catdir($testDirectory, $epilogue)));
        $leaving =~ s|(^\|/)[^/]+$||;
    }

    my $entering = $leaving;
    foreach (@components) {
        $entering .= '/' . $_;
        my $prologue = $entering . "/resources/run-webkit-tests-prologue.html";
        push @result, catdir($testDirectory, $prologue) if (stat(catdir($testDirectory, $prologue)));
        foreach (reverse @platformHierarchy) {
            push @result, catdir($_, $prologue) if (stat(catdir($_, $prologue)));
        }
    }
    return @result;
}
    
sub parseLeaksandPrintUniqueLeaks() {
    return unless @leaksFilenames;
     
    my $mergedFilenames = join " ", @leaksFilenames;
    my $parseMallocHistoryTool = sourceDir() . "/WebKitTools/Scripts/parse-malloc-history";
    
    open MERGED_LEAKS, "cat $mergedFilenames | $parseMallocHistoryTool --merge-depth $mergeDepth  - |" ;
    my @leakLines = <MERGED_LEAKS>;
    close MERGED_LEAKS;
    
    my $uniqueLeakCount = 0;
    my $totalBytes;
    foreach my $line (@leakLines) {
        ++$uniqueLeakCount if ($line =~ /^(\d*)\scalls/);
        $totalBytes = $1 if $line =~ /^total\:\s(.*)\s\(/;
    }
    
    print "\nWARNING: $totalLeaks total leaks found for a total of $totalBytes!\n";
    print "WARNING: $uniqueLeakCount unique leaks found!\n";
    print "See above for individual leaks results.\n" if ($leaksOutputFileNumber > 2);
    
}

sub extensionForMimeType($)
{
    my ($mimeType) = @_;

    if ($mimeType eq "application/x-webarchive") {
        return "webarchive";
    } elsif ($mimeType eq "application/pdf") {
        return "pdf";
    }
    return "txt";
}

# Read up to the first #EOF (the content block of the test), or until detecting crashes or timeouts.
sub readFromDumpToolWithTimer(*;$)
{
    my ($fh, $dontWaitForTimeOut) = @_;

    setFileHandleNonBlocking($fh, 1);

    my $maximumSecondsWithoutOutput = 60;
    $maximumSecondsWithoutOutput *= 10 if $guardMalloc;
    my $microsecondsToWaitBeforeReadingAgain = 1000;

    my $timeOfLastSuccessfulRead = time;

    my @output = ();
    my $status = "success";
    my $mimeType = "text/plain";
    # We don't have a very good way to know when the "headers" stop
    # and the content starts, so we use this as a hack:
    my $haveSeenContentType = 0;

    while (1) {
        if (time - $timeOfLastSuccessfulRead > $maximumSecondsWithoutOutput) {
            $status = dumpToolDidCrash() ? "crashed" : "timedOut";
            last;
        }

        my $line = readline($fh);
        if (!defined($line)) {
            if ($! != EAGAIN) {
                $status = "crashed";
                last;
            }

            if ($dontWaitForTimeOut) {
                last;
            }

            # No data ready
            usleep($microsecondsToWaitBeforeReadingAgain);
            next;
        }

        $timeOfLastSuccessfulRead = time;
        
        if (!$haveSeenContentType && $line =~ /^Content-Type: (\S+)$/) {
            $mimeType = $1;
            $haveSeenContentType = 1;
            next;
        }
        last  if ($line =~ /#EOF/);
        
        push @output, $line;
    }

    setFileHandleNonBlocking($fh, 0);
    return {
        output => join("", @output),
        status => $status,
        mimeType => $mimeType,
        extension => extensionForMimeType($mimeType)
    };
}

sub setFileHandleNonBlocking(*$)
{
    my ($fh, $nonBlocking) = @_;

    my $flags = fcntl($fh, F_GETFL, 0) or die "Couldn't get filehandle flags";

    if ($nonBlocking) {
        $flags |= O_NONBLOCK;
    } else {
        $flags &= ~O_NONBLOCK;
    }

    fcntl($fh, F_SETFL, $flags) or die "Couldn't set filehandle flags";

    return 1;
}

sub sampleDumpTool()
{
    return unless isAppleMacWebKit();
    return unless $runSample;

    my $outputDirectory = "$ENV{HOME}/Library/Logs/DumpRenderTree";
    -d $outputDirectory or mkdir $outputDirectory;

    my $outputFile = "$outputDirectory/HangReport.txt";
    system "/usr/bin/sample", $dumpToolPID, qw(10 10 -file), $outputFile;
}