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