3fc9ad306e7537cefd594d3de7bf4bd488237d57
[WebKit-https.git] / WebKitTools / Scripts / run-webkit-tests
1 #!/usr/bin/perl
2
3 # Copyright (C) 2005, 2006 Apple Computer, Inc.  All rights reserved.
4 # Copyright (C) 2006 Alexey Proskuryakov (ap@nypop.com)
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 Web Kit Open Source Project layout tests.
31
32 # Run all the tests passed in on the command line.
33 # If no tests are passed, find all the .html, .shtml, .xml, .xhtml, .pl, .php (and svg) files in the test directory.
34
35 # Run each text.
36 # Compare against the existing file xxx-expected.txt.
37 # If there is a mismatch, generate xxx-actual.txt and xxx-diffs.txt.
38
39 # At the end, report:
40 #   the number of tests that got the expected results
41 #   the number of tests that ran, but did not get the expected results
42 #   the number of tests that failed to run
43 #   the number of tests that were run but had no expected results to compare against
44
45 use strict;
46 use warnings;
47
48 use Cwd;
49 use File::Basename;
50 use File::Copy;
51 use File::Path;
52 use File::Spec;
53 use File::Spec::Functions;
54 use FindBin;
55 use Getopt::Long;
56 use IPC::Open2;
57 use Time::HiRes qw(time);
58
59 use lib $FindBin::Bin;
60 use webkitdirs;
61
62 sub closeDumpRenderTree();
63 sub closeHTTPD();
64 sub countAndPrintLeaks($$$);
65 sub fileNameWithNumber($$);
66 sub numericcmp($$);
67 sub openDumpRenderTreeIfNeeded();
68 sub openHTTPDIfNeeded();
69 sub pathcmp($$);
70 sub slowestcmp($$);
71 sub splitpath($);
72
73 # Argument handling
74 my $checkLeaks = '';
75 my $guardMalloc = '';
76 my $httpdPort = 8000;
77 my $launchSafari = 1;
78 my $pixelTests = '';
79 my $quiet = '';
80 my $repaintSweepHorizontally = '';
81 my $repaintTests = '';
82 my $report10Slowest = 0;
83 my $resetResults = 0;
84 my $singly = 0;
85 my $testHTTP = 1;
86 my $testOnlySVGs = '';
87 my $testResultsDirectory = "/tmp/layout-test-results";
88 my $verbose = 0;
89
90 my $expectedTag = "expected";
91 if (isCygwin()) {
92     $expectedTag = "expected-win";
93 }
94 my $actualTag = "actual";
95 if (isCygwin()) {
96     $actualTag = "actual-win";
97 }
98 my $diffsTag = "diffs";
99 if (isCygwin()) {
100     $actualTag = "diffs-win";
101 }
102
103 GetOptions(
104     'guard-malloc|g' => \$guardMalloc,
105     'horizontal-sweep|h' => \$repaintSweepHorizontally,
106     'http!' => \$testHTTP,
107     'launch-safari!' => \$launchSafari,
108     'leaks|l' => \$checkLeaks,
109     'pixel-tests|p' => \$pixelTests,
110     'port=i' => \$httpdPort,
111     'quiet|q' => \$quiet,
112     'repaint-tests|r' => \$repaintTests,
113     'reset-results' => \$resetResults,
114     'results-directory|o=s' => \$testResultsDirectory,
115     'singly|1' => \$singly,
116     'slowest' => \$report10Slowest,
117     'svg' => \$testOnlySVGs, 
118     'verbose|v' => \$verbose,
119 );
120
121 $repaintTests = 1 if $repaintSweepHorizontally;
122
123 $pixelTests = 1 if $testOnlySVGs;
124 $pixelTests = 1 if $repaintTests;
125
126 setConfiguration();
127 my $productDir = productDir();
128
129 chdirWebKit();
130
131 my $buildResult = system "WebKitTools/Scripts/build-dumprendertree", @ARGV;
132 exit $buildResult if $buildResult;
133
134 my $dumpToolName = "DumpRenderTree";
135 my $tool = "$productDir/$dumpToolName";
136 die "can't find executable $dumpToolName (looked in $productDir)\n" if !-x $tool;
137
138 my $imageDiffTool = "$productDir/ImageDiff";
139 die "can't find executable $imageDiffTool (looked in $productDir)\n" if $pixelTests && !-x $imageDiffTool;
140
141 checkFrameworks();
142
143 my $layoutTestsName = $testOnlySVGs? "LayoutTests/svg" : "LayoutTests";
144 my $testDirectory = getcwd() . "/$layoutTestsName";
145 my $testResults = "$testResultsDirectory/results.html";
146
147 print "Running tests from $testDirectory\n";
148
149 my @tests = ();
150
151 my $prunePart = "\\( -name resources \\! -prune \\)";
152 my $extensionPart = "-name '*.html' -or -name '*.shtml' -or -name '*.xml' -or -name '*.xhtml' -or -name '*.pl' -or -name '*.php'";
153 if ($testOnlySVGs) {
154     $extensionPart = "-name '*.svg' -or -name '*.xml'";
155 } elsif (checkWebCoreSVGSupport($testOnlySVGs)) { 
156     $extensionPart .= " -or -name '*.svg'";
157 } else {
158     $prunePart .= " -or \\( -name svg \\! -prune \\)";
159 }
160 if (!$testHTTP) {
161     $prunePart .= " -or \\( -name http \\! -prune \\)";
162 }
163 my $findArguments = "$prunePart -or $extensionPart";
164
165 my $foundTestName = 0;
166 for my $test (@ARGV) {
167     next if $test =~ /^-/;
168     $foundTestName = 1;
169     $test =~ s/^$testDirectory\///;
170     if ($test =~ /^\//) {
171         print "can't run test outside $testDirectory\n";
172     } elsif (-f "$testDirectory/$test") {
173         if ($test !~ /\.(html|shtml|xml|xhtml|pl|php|svg)$/) {
174             print "test $test does not have a supported extension\n";
175         } elsif ($testHTTP || $test !~ /^http\//) {
176             push @tests, $test;
177         }
178     } elsif (-d "$testDirectory/$test") {
179         push @tests, sort pathcmp map { chomp; s-^$testDirectory/--; $_; } `find -L "$testDirectory/$test" $findArguments`;
180     } else {
181         print "test $test not found\n";
182     }
183 }
184 if (!$foundTestName) {
185     @tests = sort pathcmp map { chomp; s-^$testDirectory/--; $_; } `find -L "$testDirectory" $findArguments`;
186 }
187
188 die "no tests to run\n" if !@tests;
189
190 my %counts;
191 my %tests;
192 my %imagesPresent;
193 my %durations;
194 my $count = 0;
195 my $maxTestsPerLeaksRun = 1000; # more than 3000 and malloc logging will normally run out of memory
196 my $leaksOutputFileNumber = 1;
197 my $totalLeaks = 0;
198
199 my @toolArgs = ();
200 push @toolArgs, "--dump-all-pixels" if $pixelTests && $resetResults;
201 push @toolArgs, "--pixel-tests" if $pixelTests;
202 push @toolArgs, "--repaint" if $repaintTests;
203 push @toolArgs, "--horizontal-sweep" if $repaintSweepHorizontally;
204 push @toolArgs, "-";
205
206 $| = 1;
207
208 my $imageDiffToolPID;
209 if ($pixelTests) {
210     local %ENV;
211     $ENV{MallocStackLogging} = 1 if $checkLeaks;
212     $imageDiffToolPID = open2(\*DIFFIN, \*DIFFOUT, $imageDiffTool, "") or die "unable to open $imageDiffTool\n";
213 }
214
215 my $dumpToolPID;
216 my $toolOpen = 0;
217
218 my $atLineStart = 1;
219 my $lastDirectory = "";
220
221 my $httpdOpen = 0;
222
223 print "Testing ", scalar @tests, " test cases.\n";
224 my $overallStartTime = time;
225
226 for my $test (@tests) {
227     next if $test eq 'results.html';
228
229     openDumpRenderTreeIfNeeded();
230
231     my $base = $test;
232     $base =~ s/\.[a-zA-Z]+$//;
233     
234     if ($verbose || $singly) {
235         print "running $test -> ";
236         $atLineStart = 0;
237     } elsif (!$quiet) {
238         my $dir = $base;
239         $dir =~ s|/[^/]+$||;
240         if ($dir ne $lastDirectory) {
241             print "\n" unless $atLineStart;
242             print "$dir ";
243             $lastDirectory = $dir;
244         }
245         print ".";
246         $atLineStart = 0;
247     }
248
249     my $result;
250
251     my $startTime = time if $report10Slowest;
252
253     if ($test !~ /^http\//) {
254         my $testPath = "$testDirectory/$test";
255         if (isCygwin()) {
256             $testPath = `cygpath -m -s "$testPath"`;
257         }
258         else {
259             $testPath = canonpath($testPath);
260         }
261         print OUT "$testPath\n";
262     } else {
263         openHTTPDIfNeeded();
264         
265         my $path = canonpath($test);
266         $path =~ s/^http\/tests\///;
267         print OUT "http://127.0.0.1:$httpdPort/$path\n";
268     }
269
270     my $actual = "";
271     while (<IN>) {
272         last if /#EOF/;
273         $actual .= $_;
274     }
275
276     $durations{$test} = time - $startTime if $report10Slowest;
277
278     my $expected;
279     if (!$resetResults && open EXPECTED, "<", "$testDirectory/$base-$expectedTag.txt") {
280         $expected = "";
281         while (<EXPECTED>) {
282             $expected .= $_;
283         }
284         close EXPECTED;
285     }
286
287     if ($checkLeaks && $singly) {
288         print "        $test -> ";
289     }
290
291     my $actualPNG = "";
292     my $diffPNG = "";
293     my $diffPercentage = "";
294     my $diffResult = "passed";
295     
296     if ($pixelTests) {
297         my $actualHash = "";
298         my $expectedHash = "";
299         my $actualPNGSize = 0;
300         while (<IN>) {
301             last if /#EOF/;
302             if (/ActualHash: ([a-f0-9]{32})/) {
303                 $actualHash = $1;
304             } elsif (/BaselineHash: ([a-f0-9]{32})/) {
305                 $expectedHash = $1;
306             } elsif (/Content-length: (\d+)\s*/) {
307                 $actualPNGSize = $1;
308                 read(IN, $actualPNG, $actualPNGSize);
309             }
310         }
311
312         if ($expectedHash ne $actualHash && -f "$testDirectory/$base-$expectedTag.png") {
313             my $expectedPNGSize = -s "$testDirectory/$base-$expectedTag.png";
314             my $expectedPNG = "";
315             open EXPECTEDPNG, "$testDirectory/$base-$expectedTag.png";
316             read(EXPECTEDPNG, $expectedPNG, $expectedPNGSize);
317
318             print DIFFOUT "Content-length: $actualPNGSize\n";
319             print DIFFOUT $actualPNG;
320
321             print DIFFOUT "Content-length: $expectedPNGSize\n";
322             print DIFFOUT $expectedPNG;
323
324             while (<DIFFIN>) {
325                 last if /^error/ || /^diff:/;
326                 if (/Content-length: (\d+)\s*/) {
327                     read(DIFFIN, $diffPNG, $1);
328                 }
329             }
330
331             if (/^diff: (.+)% (passed|failed)/) {
332                 $diffPercentage = $1;
333                 $diffResult = $2;
334             }
335         }
336
337         if ($actualPNGSize && ($resetResults || !-f "$testDirectory/$base-$expectedTag.png")) {
338             open EXPECTED, ">", "$testDirectory/$base-expected.png" or die "could not create $testDirectory/$base-expected.png\n";
339             print EXPECTED $actualPNG;
340             close EXPECTED;
341         }
342
343         # update the expected hash if the image diff said that there was no difference
344         if ($actualHash ne "" && ($resetResults || !-f "$testDirectory/$base-$expectedTag.checksum")) {
345             open EXPECTED, ">", "$testDirectory/$base-$expectedTag.checksum" or die "could not create $testDirectory/$base-$expectedTag.checksum\n";
346             print EXPECTED $actualHash;
347             close EXPECTED;
348         }
349     }
350
351     if (!defined $expected) {
352         if ($verbose || $singly) {
353             print "new " . ($resetResults ? "result" : "test") ."\n";
354             $atLineStart = 1;
355         }
356         $result = "new";
357         open EXPECTED, ">", "$testDirectory/$base-$expectedTag.txt" or die "could not create $testDirectory/$base-$expectedTag.txt\n";
358         print EXPECTED $actual;
359         close EXPECTED;
360         unlink "$testResultsDirectory/$base-$actualTag.txt";
361         unlink "$testResultsDirectory/$base-$diffsTag.txt";
362     } elsif ($actual eq $expected && $diffResult eq "passed") {
363         if ($verbose || $singly) {
364             print "succeeded\n";
365             $atLineStart = 1;
366         }
367         $result = "match";
368         unlink "$testResultsDirectory/$base-$actualTag.txt";
369         unlink "$testResultsDirectory/$base-$diffsTag.txt";
370     } else {
371         unless ($verbose || $singly) {
372             print "\n" unless $atLineStart;
373             print "$test -> ";
374         }
375         print "failed\n";
376         $atLineStart = 1;
377
378         $result = "mismatch";
379
380         my $dir = "$testResultsDirectory/$base";
381         $dir =~ s|/([^/]+)$|| or die "Failed to find test name from base\n";
382         my $testName = $1;
383         mkpath $dir;
384
385         open ACTUAL, ">", "$testResultsDirectory/$base-$actualTag.txt" or die;
386         print ACTUAL $actual;
387         close ACTUAL;
388
389         system "diff -u \"$testDirectory/$base-$expectedTag.txt\" \"$testResultsDirectory/$base-$actualTag.txt\" > \"$testResultsDirectory/$base-$diffsTag.txt\"";
390
391         if ($pixelTests && $diffPNG && $diffPNG ne "") {
392             $imagesPresent{$base} = 1;
393
394             open ACTUAL, ">", "$testResultsDirectory/$base-$actualTag.png" or die;
395             print ACTUAL $actualPNG;
396             close ACTUAL;
397
398             open DIFF, ">", "$testResultsDirectory/$base-$diffsTag.png" or die;
399             print DIFF $diffPNG;
400             close DIFF;
401             
402             copy("$testDirectory/$base-$expectedTag.png", "$testResultsDirectory/$base-$expectedTag.png");
403
404             open DIFFHTML, ">$testResultsDirectory/$base-$diffsTag.html" or die;
405             print DIFFHTML "<html>\n";
406             print DIFFHTML "<head>\n";
407             print DIFFHTML "<title>$base Image Compare</title>\n";
408             print DIFFHTML "<script language=\"Javascript\" type=\"text/javascript\">\n";
409             print DIFFHTML "var currentImage = 0;\n";
410             print DIFFHTML "var imageNames = new Array(\"Actual\", \"Expected\");\n";
411             print DIFFHTML "var imagePaths = new Array(\"$testName-$actualTag.png\", \"$testName-$expectedTag.png\");\n";
412             if (-f "$testDirectory/$base-w3c.png") {
413                 copy("$testDirectory/$base-w3c.png", "$testResultsDirectory/$base-w3c.png");
414                 print DIFFHTML "imageNames.push(\"W3C\");\n";
415                 print DIFFHTML "imagePaths.push(\"$testName-w3c.png\");\n";
416             }
417             print DIFFHTML "function animateImage() {\n";
418             print DIFFHTML "    var image = document.getElementById(\"animatedImage\");\n";
419             print DIFFHTML "    var imageText = document.getElementById(\"imageText\");\n";
420             print DIFFHTML "    image.src = imagePaths[currentImage];\n";
421             print DIFFHTML "    imageText.innerHTML = imageNames[currentImage] + \" Image\";\n";
422             print DIFFHTML "    currentImage = (currentImage + 1) % imageNames.length;\n";
423             print DIFFHTML "    setTimeout('animateImage()',2000);\n";
424             print DIFFHTML "}\n";
425             print DIFFHTML "</script>\n";
426             print DIFFHTML "</head>\n";
427             print DIFFHTML "<body onLoad=\"animateImage();\">\n";
428             print DIFFHTML "<table>\n";
429             if ($diffPercentage) {
430                 print DIFFHTML "<tr>\n";
431                 print DIFFHTML "<td>Difference between images: <a href=\"$testName-$diffsTag.png\">$diffPercentage%</a></td>\n";
432                 print DIFFHTML "</tr>\n";
433             }
434             print DIFFHTML "<tr>\n";
435             print DIFFHTML "<td id=\"imageText\" style=\"text-weight: bold;\">Actual Image</td>\n";
436             print DIFFHTML "</tr>\n";
437             print DIFFHTML "<tr>\n";
438             print DIFFHTML "<td><img src=\"$testName-$actualTag.png\" id=\"animatedImage\"></td>\n";
439             print DIFFHTML "</tr>\n";
440             print DIFFHTML "</table>\n";
441             print DIFFHTML "</body>\n";
442             print DIFFHTML "</html>\n";
443         }
444     }
445
446     if ($checkLeaks && $toolOpen) {
447         if ($singly) {
448             $totalLeaks += countAndPrintLeaks($dumpToolName, $dumpToolPID, "$testResultsDirectory/$base-leaks.txt");
449         } elsif ($count && (($count % $maxTestsPerLeaksRun) == 0)) {
450             my $leaksFileName = fileNameWithNumber($dumpToolName, $leaksOutputFileNumber);
451             my $leaksCount = countAndPrintLeaks($dumpToolName, $dumpToolPID, "$testResultsDirectory/$leaksFileName-leaks.txt");
452             $leaksOutputFileNumber++ if ($leaksCount);
453             $totalLeaks += $leaksCount;
454             closeDumpRenderTree();
455         }
456     }
457
458     if ($singly && $toolOpen) {
459         closeDumpRenderTree();
460     }
461
462     $count += 1;
463     $counts{$result} += 1;
464     push @{$tests{$result}}, $test;
465 }
466 printf "\n%0.2fs total testing time\n", (time - $overallStartTime) . "";
467
468 closeHTTPD();
469
470 if ($checkLeaks && !$singly && $toolOpen) {
471     my $leaksFileName = fileNameWithNumber($dumpToolName, $leaksOutputFileNumber);
472     $totalLeaks += countAndPrintLeaks($dumpToolName, $dumpToolPID, "$testResultsDirectory/$leaksFileName-leaks.txt");
473     $leaksOutputFileNumber++;
474 }
475
476 # FIXME: Do we really want to check the image-comparison tool for leaks every time?
477 if ($checkLeaks && $pixelTests) {
478     $totalLeaks += countAndPrintLeaks("ImageDiff", $imageDiffToolPID, "$testResultsDirectory/ImageDiff-leaks.txt");
479 }
480
481 if ($totalLeaks) {
482     print "\nWARNING: $totalLeaks total leaks found!\n";
483     print "See above for individual leaks results.\n" if ($leaksOutputFileNumber > 2);
484 }
485
486 close IN;
487 close OUT;
488
489 if ($report10Slowest) {
490     print "\n\nThe 10 slowest tests:\n\n";
491     my $count = 0;
492     for my $test (sort slowestcmp keys %durations) {
493         printf "%0.2f secs: %s\n", $durations{$test}, $test;
494         last if ++$count == 10;
495     }
496 }
497
498 print "\n";
499
500 if ($resetResults || ($counts{match} && $counts{match} == $count)) {
501     print "all $count test cases succeeded\n";
502     unlink $testResults;
503     exit;
504 }
505
506 my %text = (
507     match => "succeeded",
508     mismatch => "had incorrect layout",
509     new => "were new",
510     fail => "failed (tool did not execute successfully)",
511 );
512
513 for my $type ("match", "mismatch", "new", "fail") {
514     my $c = $counts{$type};
515     if ($c) {
516         my $t = $text{$type};
517         my $message;
518         if ($c == 1) {
519             $t =~ s/were/was/;
520             $message = sprintf "1 test case (%d%%) %s\n", 1 * 100 / $count, $t;
521         } else {
522             $message = sprintf "%d test cases (%d%%) %s\n", $c, $c * 100 / $count, $t;
523         }
524         $message =~ s-\(0%\)-(<1%)-;
525         print $message;
526     }
527 }
528
529 mkpath $testResultsDirectory;
530
531 open HTML, ">", $testResults or die;
532 print HTML "<html>\n";
533 print HTML "<head>\n";
534 print HTML "<title>Layout Test Results</title>\n";
535 print HTML "</head>\n";
536 print HTML "<body>\n";
537
538 if ($counts{mismatch}) {
539     print HTML "<p>Tests where results did not match expected results:</p>\n";
540     print HTML "<table>\n";
541     for my $test (@{$tests{mismatch}}) {
542         my $base = $test;
543         $base =~ s/\.[a-zA-Z]+$//;
544         copy("$testDirectory/$base-$expectedTag.txt", "$testResultsDirectory/$base-$expectedTag.txt");
545         print HTML "<tr>\n";            
546         print HTML "<td><a href=\"$testDirectory/$test\">$base</a></td>\n";
547         if (-s "$testResultsDirectory/$base-$diffsTag.txt") {
548             print HTML "<td><a href=\"$base-$expectedTag.txt\">expected</a></td>\n";
549             print HTML "<td><a href=\"$base-$actualTag.txt\">actual</a></td>\n";
550             print HTML "<td><a href=\"$base-$diffsTag.txt\">diffs</a></td>\n";
551         } else {
552             print HTML "<td></td><td></td><td></td>\n";
553         }
554         if ($pixelTests) {
555             if ($imagesPresent{$base}) {
556                 print HTML "<td><a href=\"$base-$expectedTag.png\">expected image</a></td>\n";
557                 print HTML "<td><a href=\"$base-$diffsTag.html\">image diffs</a></td>\n";
558             } else {
559                 print HTML "<td></td><td></td>\n";
560             }            
561         }
562         print HTML "</tr>\n";
563     }
564     print HTML "</table>\n";
565 }
566
567 if ($counts{fail}) {
568     print HTML "<p>Tests that caused the DumpRenderTree tool to fail:</p>\n";
569     print HTML "<table>\n";
570     for my $test (@{$tests{fail}}) {
571         my $base = $test;
572         $base =~ s/\.[a-zA-Z]+$//;
573         print HTML "<tr>\n";
574         print HTML "<td><a href=\"$testDirectory/$test\">$base</a></td>\n";
575         print HTML "</tr>\n";
576     }
577     print HTML "</table>\n";
578 }
579
580 if ($counts{new}) {
581     print HTML "<p>Tests that had no expected results (probably new):</p>\n";
582     print HTML "<table>\n";
583     for my $test (@{$tests{new}}) {
584         my $base = $test;
585         $base =~ s/\.[a-zA-Z]+$//;
586         print HTML "<tr>\n";
587         print HTML "<td><a href=\"$testDirectory/$test\">$base</a></td>\n";
588         print HTML "<td><a href=\"$testDirectory/$base-$expectedTag.txt\">results</a></td>\n";
589         if ($pixelTests && -f "$testDirectory/$base-$expectedTag.png") {
590             print HTML "<td><a href=\"$testDirectory/$base-$expectedTag.png\">image</a></td>\n";
591         }
592         print HTML "</tr>\n";
593     }
594     print HTML "</table>\n";
595 }
596
597 print HTML "</body>\n";
598 print HTML "</html>\n";
599 close HTML;
600
601 system "WebKitTools/Scripts/run-safari", "-NSOpen", $testResults if $launchSafari;
602
603 exit 1;
604
605 sub countAndPrintLeaks($$$)
606 {
607     my ($toolName, $toolPID, $leaksFilePath) = @_;
608
609     print "\n" unless $atLineStart;
610     $atLineStart = 1;
611
612     # We are excluding the following reported leaks so they don't get in our way when looking for WebKit leaks:
613
614     my @exclude = (
615         "pthread_create", # false positive leak of 'THRD', Radar 3387783
616         "_CFPreferencesDomainDeepCopyDictionary", # leak apparently in CFPreferences, Radar 4220786
617         "FOGetCoveredUnicodeChars", # leak apparently in ATS, Radar 3943604
618         "PCFragPrepareClosureFromFile", # leak in Code Fragment Manager, Radar 3426998
619         "Flash_EnforceLocalSecurity", # leaks in flash plugin code, Radar 4449747
620         "ICCFPrefWrapper::GetPrefDictionary()" # leaks in quicktime plugin code, Radar 4449794
621     );
622
623     # Note that the exclusion for bug 3387783 doesn't quite work right; sometimes a leak of 'THRD' will
624     # still appear in the leaks output.
625
626     my $excludes = "-exclude '" . (join "' -exclude '", @exclude) . "'";
627
628     print " ? checking for leaks in $toolName\n";
629     my $leaksOutput = `leaks $excludes $toolPID`;
630     my ($count, $bytes) = $leaksOutput =~ /Process $toolPID: (\d+) leaks? for (\d+) total/;
631     my ($excluded) = $leaksOutput =~ /(\d+) leaks? excluded/;
632
633     my $adjustedCount = $count;
634     $adjustedCount -= $excluded if $excluded;
635
636     if (!$adjustedCount) {
637         print " - no leaks found\n";
638         unlink $leaksFilePath;
639         return 0;
640     } else {
641         my $dir = $leaksFilePath;
642         $dir =~ s|/[^/]+$|| or die;
643         mkpath $dir;
644
645         if ($excluded) {
646             print " + $adjustedCount leaks ($bytes bytes including $excluded excluded leaks) were found, details in $leaksFilePath\n";
647         } else {
648             print " + $count leaks ($bytes bytes) were found, details in $leaksFilePath\n";
649         }
650
651         open LEAKS, ">", $leaksFilePath or die;
652         print LEAKS $leaksOutput;
653         close LEAKS;
654     }
655
656     return $adjustedCount;
657 }
658
659 # Break up a path into the directory (with slash) and base name.
660 sub splitpath($)
661 {
662     my ($path) = @_;
663
664     my $pathSeparator = "/";
665     my $dirname = dirname($path) . $pathSeparator;
666     $dirname = "" if $dirname eq "." . $pathSeparator;
667
668     return ($dirname, basename($path));
669 }
670
671 # Sort first by directory, then by file, so all paths in one directory are grouped
672 # rather than being interspersed with items from subdirectories.
673 # Use numericcmp to sort directory and filenames to make order logical.
674 sub pathcmp($$)
675 {
676     my ($patha, $pathb) = @_;
677
678     my ($dira, $namea) = splitpath($patha);
679     my ($dirb, $nameb) = splitpath($pathb);
680
681     return numericcmp($dira, $dirb) if $dira ne $dirb;
682     return numericcmp($namea, $nameb);
683 }
684
685 # Sort numeric parts of strings as numbers, other parts as strings.
686 # Makes 1.33 come after 1.3, which is cool.
687 sub numericcmp($$)
688 {
689     my ($aa, $bb) = @_;
690
691     my @a = split /(\d+)/, $aa;
692     my @b = split /(\d+)/, $bb;
693
694     # Compare one chunk at a time.
695     # Each chunk is either all numeric digits, or all not numeric digits.
696     while (@a && @b) {
697         my $a = shift @a;
698         my $b = shift @b;
699         
700         # Use numeric comparison if chunks are non-equal numbers.
701         return $a <=> $b if $a =~ /^\d/ && $b =~ /^\d/ && $a != $b;
702
703         # Use string comparison if chunks are any other kind of non-equal string.
704         return $a cmp $b if $a ne $b;
705     }
706     
707     # One of the two is now empty; compare lengths for result in this case.
708     return @a <=> @b;
709 }
710
711 # Sort slowest tests first.
712 sub slowestcmp($$)
713 {
714     my ($testa, $testb) = @_;
715
716     my $dura = $durations{$testa};
717     my $durb = $durations{$testb};
718     return $durb <=> $dura if $dura != $durb;
719     return pathcmp($testa, $testb);
720 }
721
722 sub openDumpRenderTreeIfNeeded()
723 {
724     return if $toolOpen;
725
726     local %ENV;
727     $ENV{DYLD_FRAMEWORK_PATH} = $productDir;
728     $ENV{XML_CATALOG_FILES} = ""; # work around missing /etc/catalog <rdar://problem/4292995>
729     $ENV{MallocStackLogging} = 1 if $checkLeaks;
730     $ENV{DYLD_INSERT_LIBRARIES} = "/usr/lib/libgmalloc.dylib" if $guardMalloc;
731     $dumpToolPID = open2(\*IN, \*OUT, $tool, @toolArgs) or die "Failed to start tool: $tool\n";
732     $toolOpen = 1;
733 }
734
735 sub closeDumpRenderTree()
736 {
737     return if !$toolOpen;
738
739     close IN;
740     close OUT;
741     waitpid $dumpToolPID, 0;
742     $toolOpen = 0;
743 }
744
745 sub openHTTPDIfNeeded()
746 {
747     return if $httpdOpen;
748
749     mkdir "/tmp/WebKit";
750     
751     if (-f "/tmp/WebKit/httpd.pid") {
752         my $oldPid = `cat /tmp/WebKit/httpd.pid`;
753         chomp $oldPid;
754         if (0 != kill 0, $oldPid) {
755             print "\nhttpd is already running: pid $oldPid, killing...\n";
756             kill 15, $oldPid;
757             
758             my $retryCount = 20;
759             while ((0 != kill 0, $oldPid) && $retryCount) {
760                 sleep 1;
761                 --$retryCount;
762             }
763             
764             die "Timed out waiting for httpd to quit" unless $retryCount;
765         }
766     }
767     
768     my $httpdPath = "/usr/sbin/httpd";
769     my $httpdConfig = "$testDirectory/http/conf/httpd.conf";
770     $httpdConfig = "$testDirectory/http/conf/apache2-httpd.conf" if `$httpdPath -v` =~ m|Apache/2|;
771     my $documentRoot = "$testDirectory/http/tests";
772     my $typesConfig = "$testDirectory/http/conf/mime.types";
773     my $listen = "127.0.0.1:$httpdPort";
774     my $absTestResultsDirectory = File::Spec->rel2abs(glob $testResultsDirectory);
775
776     mkpath $absTestResultsDirectory;
777
778     open2(\*HTTPDIN, \*HTTPDOUT, $httpdPath, 
779         "-f", "$httpdConfig",
780         "-C", "DocumentRoot \"$documentRoot\"",
781         "-C", "Listen $listen",
782         "-c", "TypesConfig \"$typesConfig\"",
783         "-c", "CustomLog \"$absTestResultsDirectory/access_log.txt\" common",
784         "-c", "ErrorLog \"$absTestResultsDirectory/error_log.txt\"",
785         # Apache wouldn't run CGIs with permissions==700 otherwise
786         "-c", "User \"#$<\"");
787
788     my $retryCount = 20;
789     while (system("/usr/bin/curl -q --silent --stderr - --output /dev/null $listen") && $retryCount) {
790         sleep 1;
791         --$retryCount;
792     }
793     
794     die "Timed out waiting for httpd to start" unless $retryCount;
795     
796     $httpdOpen = 1;
797 }
798
799 sub closeHTTPD()
800 {
801     return if !$httpdOpen;
802
803     close HTTPDIN;
804     close HTTPDOUT;
805
806     kill 15, `cat /tmp/WebKit/httpd.pid` if -f "/tmp/WebKit/httpd.pid";
807
808     $httpdOpen = 0;
809 }
810
811 sub fileNameWithNumber($$)
812 {
813     my ($base, $number) = @_;
814     return "$base$number" if ($number > 1);
815     return $base;
816 }