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