Suggested by Mitz Pettel, reviewed by Darin.
[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 = 0;
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         "-c", "User \"#" . `id -u` . "\"",  # Apache wouldn't run CGIs with permissions==700 otherwise
239         "-c", "Group \"#" . `id -g` . "\"");
240
241     sleep 1; # FIXME: need a better way to wait for Apache to bind to the port
242     $httpdOpen = 1;
243 }
244
245 sub closeHTTPD()
246 {
247     close HTTPDIN;
248     close HTTPDOUT;
249     if (-f "/tmp/WebKit/httpd.pid") {
250         kill 15, `cat /tmp/WebKit/httpd.pid`;
251         $httpdOpen = 0;
252     }
253 }
254
255 sub fileNameWithNumber($$)
256 {
257     my ($base, $number) = @_;
258     return "$base$number" if ($number > 1);
259     return $base;
260 }
261
262 for my $test (@tests) {
263     next if $test eq 'results.html';
264
265     openDumpRenderTreeIfNeeded();
266
267     my $base = $test;
268     $base =~ s/\.(html|shtml|text|xml|xhtml|svg)$//;
269     
270     if ($verbose || $singly) {
271         print "running $test -> ";
272         $atLineStart = 0;
273     } elsif (!$quiet) {
274         my $dir = $base;
275         $dir =~ s|/[^/]+$||;
276         if ($dir ne $lastDirectory) {
277             print "\n" unless $atLineStart;
278             print "$dir ";
279             $lastDirectory = $dir;
280         }
281         print ".";
282         $atLineStart = 0;
283     }
284
285     my $result;
286
287     my $startTime = time if $report10Slowest;
288
289     if ($test !~ /^http\//) {
290         print OUT "$testDirectory/$test\n";
291     } else {
292         openHTTPDIfNeeded();
293         
294         my $path = $test;
295         $path =~ s/^http\/tests\///;
296         print OUT "http://127.0.0.1:$httpdPort/$path\n";
297     }
298
299     my $actual = "";
300     while (<IN>) {
301         last if /#EOF/;
302         $actual .= $_;
303     }
304
305     $durations{$test} = time - $startTime if $report10Slowest;
306
307     my $expected;
308     if (open EXPECTED, "<", "$testDirectory/$base-expected.txt") {
309         $expected = "";
310         while (<EXPECTED>) {
311             $expected .= $_;
312         }
313         close EXPECTED;
314     }
315
316     if ($checkLeaks && $singly) {
317         print "        $test -> ";
318     }
319
320     my $textDumpMatches = (defined $expected) && ($actual eq $expected);
321     my $actualHash = "";
322     my $expectedHash = "";
323     my $hashMatches = "";
324     my $actualPNG = "";
325     my $actualPNGSize = 0;
326     my $expectedPNG = "";
327     my $expectedPNGSize = 0;
328     my $diffPNG = "";
329     my $diffPercentage = "";
330     my $diffResult = "passed";
331     
332     if ($pixelTests) {
333         while (<IN>) {
334             last if /#EOF/;
335             if (/ActualHash: ([a-f0-9]{32})/) {
336                 $actualHash = $1;
337             } elsif (/BaselineHash: ([a-f0-9]{32})/) {
338                 $expectedHash = $1;
339             } elsif (/Content-length: (\d+)\s*/) {
340                 $actualPNGSize = $1;
341                 read(IN, $actualPNG, $actualPNGSize);
342             }
343         }
344
345         if ($hashMatches = ($expectedHash eq $actualHash)) {
346             $diffResult = "passed";
347         }
348
349         if (!$hashMatches && -f "$testDirectory/$base-expected.png") {
350             $expectedPNGSize = -s "$testDirectory/$base-expected.png";
351             open EXPECTEDPNG, "$testDirectory/$base-expected.png";
352             read(EXPECTEDPNG, $expectedPNG, $expectedPNGSize);
353
354             print DIFFOUT "Content-length: $actualPNGSize\n";
355             print DIFFOUT $actualPNG;
356
357             print DIFFOUT "Content-length: $expectedPNGSize\n";
358             print DIFFOUT $expectedPNG;
359
360             while (<DIFFIN>) {
361                 last if /^error/ || /^diff:/;
362                 if (/Content-length: (\d+)\s*/) {
363                     read(DIFFIN, $diffPNG, $1);
364                 }
365             }
366
367             if (/^diff: (.+)% (passed|failed)/) {
368                 $diffPercentage = $1;
369                 $diffResult = $2;
370             }
371         }
372     }
373
374     if ($pixelTests) {
375         if ($actualPNGSize != 0 && ! -f "$testDirectory/$base-expected.png") {
376             open EXPECTED, ">", "$testDirectory/$base-expected.png" or die "could not create $testDirectory/$base-expected.png\n";
377             print EXPECTED $actualPNG;
378             close EXPECTED;
379         }
380
381         # update the expected hash if the image diff said that there was no difference
382         if ($actualHash ne "" && ! -f "$testDirectory/$base-expected.checksum") {
383             open EXPECTED, ">", "$testDirectory/$base-expected.checksum" or die "could not create $testDirectory/$base-expected.checksum\n";
384             print EXPECTED $actualHash;
385             close EXPECTED;
386         }
387     }
388
389     if (!defined $expected) {
390         if ($verbose || $singly) {
391             print "new test\n";
392             $atLineStart = 1;
393         }
394         $result = "new";
395         open EXPECTED, ">", "$testDirectory/$base-expected.txt" or die "could not create $testDirectory/$base-expected.txt\n";
396         print EXPECTED $actual;
397         close EXPECTED;
398         unlink "$testResultsDirectory/$base-actual.txt";
399         unlink "$testResultsDirectory/$base-diffs.txt";
400     } elsif ($textDumpMatches && (!$pixelTests || ($pixelTests && $diffResult eq "passed"))) {
401         if ($verbose || $singly) {
402             print "succeeded\n";
403             $atLineStart = 1;
404         }
405         $result = "match";
406         unlink "$testResultsDirectory/$base-actual.txt";
407         unlink "$testResultsDirectory/$base-diffs.txt";
408     } elsif (!$textDumpMatches || ($pixelTests && $diffResult ne "passed")) {
409         unless ($verbose || $singly) {
410             print "\n" unless $atLineStart;
411             print "$test -> ";
412         }
413         print "failed\n";
414         $atLineStart = 1;
415
416         $result = "mismatch";
417
418         my $dir = "$testResultsDirectory/$base";
419         $dir =~ s|/([^/]+)$|| or die "Failed to find test name from base\n";
420         my $testName = $1;
421         mkpath $dir;
422
423         open ACTUAL, ">", "$testResultsDirectory/$base-actual.txt" or die;
424         print ACTUAL $actual;
425         close ACTUAL;
426
427         system "diff -u \"$testDirectory/$base-expected.txt\" \"$testResultsDirectory/$base-actual.txt\" > \"$testResultsDirectory/$base-diffs.txt\"";
428
429         if ($pixelTests && $diffPNG && $diffPNG ne "") {
430             $imagesPresent{$base} = 1;
431
432             open ACTUAL, ">", "$testResultsDirectory/$base-actual.png" or die;
433             print ACTUAL $actualPNG;
434             close ACTUAL;
435
436             open DIFF, ">", "$testResultsDirectory/$base-diffs.png" or die;
437             print DIFF $diffPNG;
438             close DIFF;
439             
440             copy("$testDirectory/$base-expected.png", "$testResultsDirectory/$base-expected.png");
441
442             open DIFFHTML, ">$testResultsDirectory/$base-diffs.html" or die;
443             print DIFFHTML "<html>\n";
444             print DIFFHTML "<head>\n";
445             print DIFFHTML "<title>$base Image Compare</title>\n";
446             print DIFFHTML "<script language=\"Javascript\" type=\"text/javascript\">\n";
447             print DIFFHTML "var currentImage = 0;\n";
448             print DIFFHTML "var imageNames = new Array(\"Actual\", \"Expected\");\n";
449             print DIFFHTML "var imagePaths = new Array(\"$testName-actual.png\", \"$testName-expected.png\");\n";
450             if (-f "$testDirectory/$base-w3c.png") {
451                 copy("$testDirectory/$base-w3c.png", "$testResultsDirectory/$base-w3c.png");
452                 print DIFFHTML "imageNames.push(\"W3C\");\n";
453                 print DIFFHTML "imagePaths.push(\"$testName-w3c.png\");\n";
454             }
455             print DIFFHTML "function animateImage() {\n";
456             print DIFFHTML "    var image = document.getElementById(\"animatedImage\");\n";
457             print DIFFHTML "    var imageText = document.getElementById(\"imageText\");\n";
458             print DIFFHTML "    image.src = imagePaths[currentImage];\n";
459             print DIFFHTML "    imageText.innerHTML = imageNames[currentImage] + \" Image\";\n";
460             print DIFFHTML "    currentImage = (currentImage + 1) % imageNames.length;\n";
461             print DIFFHTML "    setTimeout('animateImage()',2000);\n";
462             print DIFFHTML "}\n";
463             print DIFFHTML "</script>\n";
464             print DIFFHTML "</head>\n";
465             print DIFFHTML "<body onLoad=\"animateImage();\">\n";
466             print DIFFHTML "<table>\n";
467             if ($diffPercentage) {
468                 print DIFFHTML "<tr>\n";
469                 print DIFFHTML "<td>Difference between images: <a href=\"$testName-diffs.png\">$diffPercentage%</a></td>\n";
470                 print DIFFHTML "</tr>\n";
471             }
472             print DIFFHTML "<tr>\n";
473             print DIFFHTML "<td id=\"imageText\" style=\"text-weight: bold;\">Actual Image</td>\n";
474             print DIFFHTML "</tr>\n";
475             print DIFFHTML "<tr>\n";
476             print DIFFHTML "<td><img src=\"$testName-actual.png\" id=\"animatedImage\"></td>\n";
477             print DIFFHTML "</tr>\n";
478             print DIFFHTML "</table>\n";
479             print DIFFHTML "</body>\n";
480             print DIFFHTML "</html>\n";
481         }
482     } else {
483         $result = "fail";
484         print "\n" unless $atLineStart;
485         print "$test -> crashed?\n";
486         $atLineStart = 1;
487         closeDumpRenderTree();
488     }
489
490     if ($checkLeaks && $toolOpen) {
491         if ($singly) {
492             $totalLeaks += countAndPrintLeaks($dumpToolName, $dumpToolPID, "$testResultsDirectory/$base-leaks.txt");
493         } elsif ($count && (($count % $maxTestsPerLeaksRun) == 0)) {
494             my $leaksFileName = fileNameWithNumber($dumpToolName, $leaksOutputFileNumber);
495             my $leaksCount = countAndPrintLeaks($dumpToolName, $dumpToolPID, "$testResultsDirectory/$leaksFileName-leaks.txt");
496             $leaksOutputFileNumber++ if ($leaksCount);
497             $totalLeaks += $leaksCount;
498             closeDumpRenderTree();
499         }
500     }
501
502     if ($singly && $toolOpen) {
503         closeDumpRenderTree();
504     }
505
506     $count += 1;
507     $counts{$result} += 1;
508     push @{$tests{$result}}, $test;
509 }
510
511 if ($httpdOpen) {
512     closeHTTPD();
513 }
514
515 if ($checkLeaks && !$singly && $toolOpen) {
516     my $leaksFileName = fileNameWithNumber($dumpToolName, $leaksOutputFileNumber);
517     $totalLeaks += countAndPrintLeaks($dumpToolName, $dumpToolPID, "$testResultsDirectory/$leaksFileName-leaks.txt");
518     $leaksOutputFileNumber++;
519 }
520
521 # FIXME: Do we really want to check the image-comparison tool for leaks every time?
522 if ($checkLeaks && $pixelTests) {
523     $totalLeaks += countAndPrintLeaks("ImageDiff", $imageDiffToolPID, "$testResultsDirectory/ImageDiff-leaks.txt");
524 }
525
526 if ($totalLeaks) {
527     print "\nWARNING: $totalLeaks total leaks found!\n";
528     print "See above for individual leaks results.\n" if ($leaksOutputFileNumber > 2);
529 }
530
531 close IN;
532 close OUT;
533
534 my %text = (
535     match => "succeeded",
536     mismatch => "had incorrect layout",
537     new => "were new",
538     fail => "failed (tool did not execute successfully)",
539 );
540
541 if ($report10Slowest) {
542     print "\n\nThe 10 slowest tests:\n\n";
543     my $count = 0;
544     for my $test (sort slowestcmp keys %durations) {
545         printf "%0.2f secs: %s\n", $durations{$test}, $test;
546         last if ++$count == 10;
547     }
548 }
549
550 print "\n";
551
552 if ($counts{match} && $counts{match} == $count) {
553     print "all $count test cases succeeded\n";
554     unlink $testResults;
555 } else {
556     for my $type ("match", "mismatch", "new", "fail") {
557         my $c = $counts{$type};
558         if ($c) {
559             my $t = $text{$type};
560             my $message;
561             if ($c == 1) {
562                 $t =~ s/were/was/;
563                 $message = sprintf "1 test case (%d%%) %s\n", 1 * 100 / $count, $t;
564             } else {
565                 $message = sprintf "%d test cases (%d%%) %s\n", $c, $c * 100 / $count, $t;
566             }
567             $message =~ s-\(0%\)-(<1%)-;
568             print $message;
569         }
570     }
571     
572     mkpath $testResultsDirectory;
573
574     open HTML, ">", $testResults or die;
575     print HTML "<html>\n";
576     print HTML "<head>\n";
577     print HTML "<title>Layout Test Results</title>\n";
578     print HTML "</head>\n";
579     print HTML "<body>\n";
580
581     if ($counts{mismatch}) {
582         print HTML "<p>Tests where results did not match expected results:</p>\n";
583         print HTML "<table>\n";
584         for my $test (@{$tests{mismatch}}) {
585             my $base = $test;
586             $base =~ s/\.(html|shtml|text|xml|xhtml|svg)$//;
587             copy("$testDirectory/$base-expected.txt", "$testResultsDirectory/$base-expected.txt");
588             print HTML "<tr>\n";            
589             print HTML "<td><a href=\"$testDirectory/$test\">$base</a></td>\n";
590             if (-s "$testResultsDirectory/$base-diffs.txt") {
591                 print HTML "<td><a href=\"$base-expected.txt\">expected</a></td>\n";
592                 print HTML "<td><a href=\"$base-actual.txt\">actual</a></td>\n";
593                 print HTML "<td><a href=\"$base-diffs.txt\">diffs</a></td>\n";
594             } else {
595                 print HTML "<td></td><td></td><td></td>\n";
596             }
597             if ($pixelTests) {
598                 if ($imagesPresent{$base}) {
599                     print HTML "<td><a href=\"$base-expected.png\">expected image</a></td>\n";
600                     print HTML "<td><a href=\"$base-diffs.html\">image diffs</a></td>\n";
601                 } else {
602                     print HTML "<td></td><td></td>\n";
603                 }            
604             }
605             print HTML "</tr>\n";
606         }
607         print HTML "</table>\n";
608     }
609
610     if ($counts{fail}) {
611         print HTML "<p>Tests that caused the DumpRenderTree tool to fail:</p>\n";
612         print HTML "<table>\n";
613         for my $test (@{$tests{fail}}) {
614             my $base = $test;
615             $base =~ s/\.(html|shtml|text|xml|xhtml|svg)$//;
616             print HTML "<tr>\n";
617             print HTML "<td><a href=\"$testDirectory/$test\">$base</a></td>\n";
618             print HTML "</tr>\n";
619         }
620         print HTML "</table>\n";
621     }
622
623     if ($counts{new}) {
624         print HTML "<p>Tests that had no expected results (probably new):</p>\n";
625         print HTML "<table>\n";
626         for my $test (@{$tests{new}}) {
627             my $base = $test;
628             $base =~ s/\.(html|shtml|text|xml|xhtml|svg)$//;
629             print HTML "<tr>\n";
630             print HTML "<td><a href=\"$testDirectory/$test\">$base</a></td>\n";
631             print HTML "<td><a href=\"$testDirectory/$base-expected.txt\">results</a></td>\n";
632             if ($pixelTests && -f "$testDirectory/$base-expected.png") {
633                 print HTML "<td><a href=\"$testDirectory/$base-expected.png\">image</a></td>\n";
634             }
635             print HTML "</tr>\n";
636         }
637         print HTML "</table>\n";
638     }
639
640     print HTML "</body>\n";
641     print HTML "</html>\n";
642     close HTML;
643     
644     if ($launchSafari) {
645         system "WebKitTools/Scripts/run-safari", "-NSOpen", $testResults;
646     }
647     
648     exit 1;
649 }
650
651 sub countAndPrintLeaks
652 {
653     my ($toolName, $toolPID, $leaksFilePath) = @_;
654
655     print "\n" unless $atLineStart;
656     $atLineStart = 1;
657
658     # We are excluding the following reported leaks so they don't get in our way when looking for WebKit leaks:
659
660     my @exclude = (
661         "pthread_create", # false positive leak of 'THRD', Radar 3387783
662         "_CFPreferencesDomainDeepCopyDictionary", # leak apparently in CFPreferences, Radar 4220786
663         "+[NSLanguage initialize]", # leak apparently in NSLanguage, Radar 3986177
664         "FOGetCoveredUnicodeChars", # leak apparently in ATS, Radar 3943604
665         "PCFragPrepareClosureFromFile", # leak in Code Fragment Manager, Radar 3426998
666         "Flash_EnforceLocalSecurity", # leaks in flash plugin code, Radar 4449747
667         "ICCFPrefWrapper::GetPrefDictionary()" # leaks in quicktime plugin code, Radar 4449794
668     );
669
670     # Note that this exclusion doesn't quite work right; sometimes a leak of 'THRD' with no stack trace will
671     # still appear in the leaks output.
672
673     my $excludes = "-exclude '" . (join "' -exclude '", @exclude) . "'";
674
675     print " ? checking for leaks in $toolName\n";
676     my $leaksOutput = `leaks $excludes $toolPID`;
677     my ($count, $bytes) = $leaksOutput =~ /Process $toolPID: (\d+) leaks? for (\d+) total/;
678     my ($excluded) = $leaksOutput =~ /(\d+) leaks? excluded/;
679
680     my $adjustedCount = $count;
681     $adjustedCount -= $excluded if $excluded;
682
683     if ($adjustedCount == 0) {
684         print " - no leaks found\n";
685         unlink $leaksFilePath;
686         return 0;
687     } else {
688         my $dir = $leaksFilePath;
689         $dir =~ s|/[^/]+$|| or die;
690         mkpath $dir;
691
692         if ($excluded) {
693             print " + $adjustedCount leaks ($bytes bytes including $excluded excluded leaks) were found, details in $leaksFilePath\n";
694         } else {
695             print " + $count leaks ($bytes bytes) were found, details in $leaksFilePath\n";
696         }
697
698         open LEAKS, ">", $leaksFilePath or die;
699         print LEAKS $leaksOutput;
700         close LEAKS;
701     }
702
703     return $adjustedCount;
704 }
705
706 # Break up a path into the directory (with slash) and base name.
707 sub splitpath($)
708 {
709     my ($path) = @_;
710
711     return ($1, $2) if $path =~ m|^(.*/)([^/]+)$|;
712     return ("", $path);
713 }
714
715 # Sort first by directory, then by file, so all paths in one directory are grouped
716 # rather than being interspersed with items from subdirectories.
717 # Use numericcmp to sort directory and filenames to make order logical.
718 sub pathcmp($$)
719 {
720     my ($patha, $pathb) = @_;
721
722     my ($dira, $namea) = splitpath($patha);
723     my ($dirb, $nameb) = splitpath($pathb);
724
725     return numericcmp($dira, $dirb) if $dira ne $dirb;
726     return numericcmp($namea, $nameb);
727 }
728
729 # Sort numeric parts of strings as numbers, other parts as strings.
730 # Makes 1.33 come after 1.3, which is cool.
731 sub numericcmp($$)
732 {
733     my ($aa, $bb) = @_;
734
735     my @a = split /(\d+)/, $aa;
736     my @b = split /(\d+)/, $bb;
737
738     # Compare one chunk at a time.
739     # Each chunk is either all numeric digits, or all not numeric digits.
740     while (@a && @b) {
741         my $a = shift @a;
742         my $b = shift @b;
743         
744         # Use numeric comparison if chunks are non-equal numbers.
745         return $a <=> $b if $a =~ /^\d/ && $b =~ /^\d/ && $a != $b;
746
747         # Use string comparison if chunks are any other kind of non-equal string.
748         return $a cmp $b if $a ne $b;
749     }
750     
751     # One of the two is now empty; compare lengths for result in this case.
752     return @a <=> @b;
753 }
754
755 # Sort slowest tests first.
756 sub slowestcmp($$)
757 {
758     my ($testa, $testb) = @_;
759
760     my $dura = $durations{$testa};
761     my $durb = $durations{$testb};
762     return $durb <=> $dura if $dura != $durb;
763     return pathcmp($testa, $testb);
764 }