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