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