WebKitTools/Scripts/run-webkit-tests

   1 #!/usr/bin/perl -w
   2
   3 # Copyright (C) 2005 Apple Computer, Inc.  All rights reserved.
   4 #
   5 # Redistribution and use in source and binary forms, with or without
   6 # modification, are permitted provided that the following conditions
   7 # are met:
   8 #
   9 # 1.  Redistributions of source code must retain the above copyright
  10 #     notice, this list of conditions and the following disclaimer.
  11 # 2.  Redistributions in binary form must reproduce the above copyright
  12 #     notice, this list of conditions and the following disclaimer in the
  13 #     documentation and/or other materials provided with the distribution.
  14 # 3.  Neither the name of Apple Computer, Inc. ("Apple") nor the names of
  15 #     its contributors may be used to endorse or promote products derived
  16 #     from this software without specific prior written permission.
  17 #
  18 # THIS SOFTWARE IS PROVIDED BY APPLE AND ITS CONTRIBUTORS "AS IS" AND ANY
  19 # EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
  20 # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
  21 # DISCLAIMED. IN NO EVENT SHALL APPLE OR ITS CONTRIBUTORS BE LIABLE FOR ANY
  22 # DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
  23 # (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
  24 # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
  25 # ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
  26 # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
  27 # THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  28
  29 # Script to run the Web Kit Open Source Project layout tests.
  30
  31 use strict;
  32 use IPC::Open2;
  33 use Getopt::Long;
  34 use File::Path;
  35 use FindBin;
  36 use Cwd;
  37 use lib $FindBin::Bin;
  38 use webkitdirs;
  39
  40 # Run all the tests passed in on the command line.
  41 # If no tests are passed, find all the .html, .xml, .xhtml (and svg) files in the test directory.
  42
  43 # Run each text.
  44 # Compare against the existing file xxx-expected.txt.
  45 # If there is a mismatch, generate xxx-actual.txt and xxx-diffs.txt.
  46
  47 # At the end, report:
  48 #   the number of tests that got the expected results
  49 #   the number of tests that ran, but did not get the expected results
  50 #   the number of tests that failed to run
  51 #   the number of tests that were run but had no expected results to compare against
  52
  53 setConfiguration();
  54 my $productDir = productDir();
  55
  56 chdirWebKit();
  57
  58 # Argument handling
  59 my $testSVGs = '';
  60 my $pixelTests = '';
  61 my $checkLeaks = '';
  62 my $guardMalloc = '';
  63 my $maxWidth = '';
  64 my $maxHeight = '';
  65 my $verbose = 0;
  66 my $quiet = '';
  67 my $singly = 0;
  68
  69 GetOptions('svg' => \$testSVGs,
  70     'pixel-tests|p' => \$pixelTests,
  71     'leaks|l' => \$checkLeaks,
  72     'guard-malloc|g' => \$guardMalloc,
  73     'max-width|w' => \$maxWidth,
  74     'max-height|h' => \$maxHeight,
  75     'verbose|v' => \$verbose,
  76     'quiet|q' => \$quiet,
  77     'singly|1' => \$singly);
  78
  79 my $dumpToolName = "DumpRenderTree";
  80 my $result = system "WebKitTools/Scripts/build-dumprendertree", @ARGV;
  81 exit $result if $result;
  82 if ($testSVGs) {
  83     my $result = system "WebKitTools/Scripts/build-dumpkcanvastree", @ARGV;
  84     exit $result if $result;
  85     $dumpToolName = "DumpKCanvasTree";
  86     $pixelTests = 1; # Pixel tests are always on for SVG.
  87 }
  88
  89 my $tool = "$productDir/$dumpToolName";
  90 my $imageDiffTool = "$productDir/ImageDiff";
  91 die "can't find executable $dumpToolName (looked in $productDir)\n" if !-x $tool;
  92 die "can't find executable $imageDiffTool (looked in $productDir)\n" if $pixelTests && !-x $imageDiffTool;
  93
  94 checkFrameworks();
  95 checkWebCoreSVGSupport() if $testSVGs;
  96
  97 my $layoutTestsName = "LayoutTests";
  98 if ($testSVGs) {
  99     $layoutTestsName = "SVGSupport/layout-tests";
 100 }
 101
 102 my $workingDir = getcwd();
 103 my $testDirectory = "$workingDir/$layoutTestsName";
 104 my $testResultsDirectory = "/tmp/layout-test-results";
 105 my $testResults = "$testResultsDirectory/results.html";
 106
 107 my @tests = ();
 108
 109 my $findArguments = "\\( -name resources \\! -prune \\) -or -name '*.html' -or -name '*.xml' -or -name '*.xhtml'";
 110 if ($testSVGs) {
 111     $findArguments = "\\( -name resources \\! -prune \\) -or -name '*.svg'";
 112 }
 113 my $foundTestName = 0;
 114 for my $test (@ARGV) {
 115     next if $test =~ /^-/;
 116     $foundTestName = 1;
 117     $test =~ s/^$testDirectory\///;
 118     if ($test =~ /^\//) {
 119         print "can't run test outside $testDirectory\n";
 120     } elsif (-f "$testDirectory/$test") {
 121         if ($test !~ /\.(html|xml|xhtml|svg)$/) {
 122             print "test $test does not have a supported extension\n";
 123         } else {
 124             push @tests, $test;
 125         }
 126     } elsif (-d "$testDirectory/$test") {
 127         push @tests, sort pathcmp map { chomp; s-^$testDirectory/--; $_; } `find -Ls $testDirectory/$test $findArguments`;
 128     } else {
 129         print "test $test not found\n";
 130     }
 131 }
 132 if (!$foundTestName) {
 133     @tests = sort pathcmp map { chomp; s-^$testDirectory/--; $_; } `find -Ls $testDirectory $findArguments`;
 134 }
 135
 136 die "no tests to run\n" if !@tests;
 137
 138 my %counts;
 139 my %tests;
 140 my %imagesPresent;
 141 my $count = 0;
 142
 143 my @toolArgs = ();
 144
 145 if ($pixelTests) {
 146     push @toolArgs, "--pixel-tests";
 147     push @toolArgs, ("--width", $maxWidth) if $maxWidth;
 148     push @toolArgs, ("--height", $maxHeight) if $maxHeight;
 149 }
 150
 151 push @toolArgs, "-";
 152
 153 $| = 1;
 154
 155 my $imageDiffToolPID;
 156 if ($pixelTests) {
 157     $imageDiffToolPID = open2(\*DIFFIN, \*DIFFOUT, $imageDiffTool, "") or die "unable to open $imageDiffTool\n";
 158 }
 159
 160 my $dumpToolPID;
 161 my $toolOpen = 0;
 162
 163 my $atLineStart = 1;
 164 my $lastDirectory = "";
 165
 166 for my $test (@tests) {
 167     next if $test eq 'results.html';
 168
 169     if (!$toolOpen) {
 170         local %ENV;
 171         $ENV{DYLD_FRAMEWORK_PATH} = $productDir;
 172         $ENV{MallocStackLogging} = 1 if $checkLeaks;
 173         $ENV{DYLD_INSERT_LIBRARIES} = "/usr/lib/libgmalloc.dylib" if $guardMalloc;
 174         $dumpToolPID = open2(\*IN, \*OUT, $tool, @toolArgs) or die;
 175         $toolOpen = 1;
 176     }
 177
 178     my $base = $test;
 179     $base =~ s/\.(html|xml|xhtml|svg)$//;
 180
 181     if ($verbose || $singly) {
 182         print "running $test -> ";
 183         $atLineStart = 0;
 184     } elsif (!$quiet) {
 185         my $dir = $base;
 186         $dir =~ s|/[^/]+$||;
 187         if ($dir ne $lastDirectory) {
 188             print "\n" unless $atLineStart;
 189             print "$dir ";
 190             $lastDirectory = $dir;
 191         }
 192         print ".";
 193         $atLineStart = 0;
 194     }
 195
 196     my $result;
 197
 198     print OUT "$testDirectory/$test\n";
 199
 200     my $actual = "";
 201     while (<IN>) {
 202         last if /#EOF/;
 203         $actual .= $_;
 204     }
 205
 206     my $expected;
 207     if (open EXPECTED, "<", "$testDirectory/$base-expected.txt") {
 208         $expected = "";
 209         while (<EXPECTED>) {
 210             $expected .= $_;
 211         }
 212         close EXPECTED;
 213     }
 214
 215     if ($checkLeaks && $singly) {
 216         print "        $test -> ";
 217     }
 218
 219     my $textDumpMatches = $expected && ($actual eq $expected);
 220     my $actualHash = "";
 221     my $expectedHash = "";
 222     my $hashMatches = "";
 223     my $actualPNG = "";
 224     my $actualPNGSize = 0;
 225     my $expectedPNG = "";
 226     my $expectedPNGSize = 0;
 227     my $diffPNG = "";
 228     my $diffPercentage = "";
 229     my $diffResult = "passed";
 230
 231     if ($pixelTests) {
 232         while (<IN>) {
 233             last if /#EOF/;
 234             if (/ActualHash: ([a-f0-9]{32})/) {
 235                 $actualHash = $1;
 236             } elsif (/BaselineHash: ([a-f0-9]{32})/) {
 237                 $expectedHash = $1;
 238             } elsif (/Content-length: (\d+)\s*/) {
 239                 $actualPNGSize = $1;
 240                 read(IN, $actualPNG, $actualPNGSize);
 241             }
 242         }
 243
 244         if ($hashMatches = ($expectedHash eq $actualHash)) {
 245             $diffResult = "passed";
 246         }
 247
 248         if (!$hashMatches && -f "$testDirectory/$base-expected.png") {
 249             $expectedPNGSize = -s "$testDirectory/$base-expected.png";
 250             open EXPECTEDPNG, "$testDirectory/$base-expected.png";
 251             read(EXPECTEDPNG, $expectedPNG, $expectedPNGSize);
 252
 253             print DIFFOUT "Content-length: $actualPNGSize\n";
 254             print DIFFOUT $actualPNG;
 255
 256             print DIFFOUT "Content-length: $expectedPNGSize\n";
 257             print DIFFOUT $expectedPNG;
 258
 259             while (<DIFFIN>) {
 260                 last if /^error/ || /^diff:/;
 261                 if (/Content-length: (\d+)\s*/) {
 262                     read(DIFFIN, $diffPNG, $1);
 263                 }
 264             }
 265
 266             if (/^diff: (.+)% (passed|failed)/) {
 267                 $diffPercentage = $1;
 268                 $diffResult = $2;
 269             }
 270         }
 271     }
 272
 273     if ($pixelTests) {
 274         if ($actualPNGSize != 0 && ! -f "$testDirectory/$base-expected.png") {
 275             open EXPECTED, ">", "$testDirectory/$base-expected.png" or die "could not create $testDirectory/$base-expected.png\n";
 276             print EXPECTED $actualPNG;
 277             close EXPECTED;
 278         }
 279
 280         # update the expected hash if the image diff said that there was no difference
 281         if ($actualHash ne "" && ! -f "$testDirectory/$base-expected.checksum") {
 282             open EXPECTED, ">", "$testDirectory/$base-expected.checksum" or die "could not create $testDirectory/$base-expected.checksum\n";
 283             print EXPECTED $actualHash;
 284             close EXPECTED;
 285         }
 286     }
 287
 288     if (!defined $expected) {
 289         if ($verbose || $singly) {
 290             print "new test\n";
 291             $atLineStart = 1;
 292         }
 293         $result = "new";
 294         open EXPECTED, ">", "$testDirectory/$base-expected.txt" or die "could not create $testDirectory/$base-expected.txt\n";
 295         print EXPECTED $actual;
 296         close EXPECTED;
 297         unlink "$testResultsDirectory/$base-actual.txt";
 298         unlink "$testResultsDirectory/$base-diffs.txt";
 299     } elsif ($textDumpMatches && (!$pixelTests || ($pixelTests && $diffResult eq "passed"))) {
 300         if ($verbose || $singly) {
 301             print "succeeded\n";
 302             $atLineStart = 1;
 303         }
 304         $result = "match";
 305         unlink "$testResultsDirectory/$base-actual.txt";
 306         unlink "$testResultsDirectory/$base-diffs.txt";
 307     } elsif (!$textDumpMatches || ($pixelTests && $diffResult ne "passed")) {
 308         unless ($verbose || $singly) {
 309             print "\n" unless $atLineStart;
 310             print "$test -> ";
 311         }
 312         print "failed\n";
 313         $atLineStart = 1;
 314
 315         $result = "mismatch";
 316
 317         my $dir = "$testResultsDirectory/$base";
 318         $dir =~ s|/[^/]+$|| or die;
 319         mkpath $dir;
 320
 321         open ACTUAL, ">", "$testResultsDirectory/$base-actual.txt" or die;
 322         print ACTUAL $actual;
 323         close ACTUAL;
 324
 325         system "diff -u \"$testDirectory/$base-expected.txt\" \"$testResultsDirectory/$base-actual.txt\" > \"$testResultsDirectory/$base-diffs.txt\"";
 326
 327         if ($pixelTests && $diffPNG && $diffPNG ne "") {
 328             $imagesPresent{$base} = 1;
 329
 330             open ACTUAL, ">", "$testResultsDirectory/$base-actual.png" or die;
 331             print ACTUAL $actualPNG;
 332             close ACTUAL;
 333
 334             open DIFF, ">", "$testResultsDirectory/$base-diffs.png" or die;
 335             print DIFF $diffPNG;
 336             close DIFF;
 337
 338             open DIFFHTML, ">$testResultsDirectory/$base-diffs.html" or die;
 339             print DIFFHTML "<html>\n";
 340             print DIFFHTML "<head>\n";
 341             print DIFFHTML "<title>$base Image Compare</title>\n";
 342             print DIFFHTML "<script language=\"Javascript\" type=\"text/javascript\">\n";
 343             print DIFFHTML "var currentImage = 0;\n";
 344             print DIFFHTML "var imageNames = new Array(\"Actual\", \"Expected\");\n";
 345             print DIFFHTML "var imagePaths = new Array(\"$testResultsDirectory/$base-actual.png\", \"$testDirectory/$base-expected.png\");\n";
 346             if (-f "$testDirectory/$base-w3c.png") {
 347                 print DIFFHTML "imageNames.push(\"W3C\");\n";
 348                 print DIFFHTML "imagePaths.push(\"$testDirectory/$base-w3c.png\");\n";
 349             }
 350             print DIFFHTML "function animateImage() {\n";
 351             print DIFFHTML "    var image = document.getElementById(\"animatedImage\");\n";
 352             print DIFFHTML "    var imageText = document.getElementById(\"imageText\");\n";
 353             print DIFFHTML "    image.src = imagePaths[currentImage];\n";
 354             print DIFFHTML "    imageText.innerHTML = imageNames[currentImage] + \" Image\";\n";
 355             print DIFFHTML "    currentImage = (currentImage + 1) % imageNames.length;\n";
 356             print DIFFHTML "    setTimeout('animateImage()',2000);\n";
 357             print DIFFHTML "}\n";
 358             print DIFFHTML "</script>\n";
 359             print DIFFHTML "</head>\n";
 360             print DIFFHTML "<body onLoad=\"animateImage();\">\n";
 361             print DIFFHTML "<table>\n";
 362             if ($diffPercentage) {
 363                 print DIFFHTML "<tr>\n";
 364                 print DIFFHTML "<td>Difference between images: <a href=\"$testResultsDirectory/$base-diffs.png\">$diffPercentage%</a></td>\n";
 365                 print DIFFHTML "</tr>\n";
 366             }
 367             print DIFFHTML "<tr>\n";
 368             print DIFFHTML "<td id=\"imageText\" style=\"text-weight: bold;\">Actual Image</td>\n";
 369             print DIFFHTML "</tr>\n";
 370             print DIFFHTML "<tr>\n";
 371             print DIFFHTML "<td><img src=\"$testResultsDirectory/$base-actual.png\" id=\"animatedImage\"></td>\n";
 372             print DIFFHTML "</tr>\n";
 373             print DIFFHTML "</table>\n";
 374             print DIFFHTML "</body>\n";
 375             print DIFFHTML "</html>\n";
 376         }
 377     } else {
 378         $result = "fail";
 379         print "\n" unless $atLineStart;
 380         print "$test -> crashed?\n";
 381         $atLineStart = 1;
 382
 383         close IN;
 384         close OUT;
 385         $toolOpen = 0;
 386     }
 387
 388     if ($checkLeaks && $singly && $toolOpen) {
 389         printLeaks($dumpToolName, $dumpToolPID, "$testResultsDirectory/$base-leaks.txt");
 390     }
 391
 392     if ($singly && $toolOpen) {
 393         close IN;
 394         close OUT;
 395         waitpid $dumpToolPID, 0;
 396         $toolOpen = 0;
 397     }
 398
 399     $count += 1;
 400     $counts{$result} += 1;
 401     push @{$tests{$result}}, $test;
 402 }
 403
 404 if ($checkLeaks && !$singly && $toolOpen) {
 405     printLeaks($dumpToolName, $dumpToolPID, "$testResultsDirectory/$dumpToolName-leaks.txt");
 406 }
 407
 408 # FIXME: Do we really want to check the image-comparison tool for leaks?
 409 if ($checkLeaks && $pixelTests) {
 410     printLeaks("ImageDiff", $imageDiffToolPID, "$testResultsDirectory/ImageDiff-leaks.txt");
 411 }
 412
 413 close IN;
 414 close OUT;
 415
 416 my %text = (
 417     match => "succeeded",
 418     mismatch => "had incorrect layout",
 419     new => "were new",
 420     fail => "failed (tool did not execute successfully)",
 421 );
 422
 423 print "\n";
 424
 425 if ($counts{match} && $counts{match} == $count) {
 426     print "all $count test cases succeeded\n";
 427     unlink $testResults;
 428 } else {
 429     for my $type ("match", "mismatch", "new", "fail") {
 430         my $c = $counts{$type};
 431         if ($c) {
 432             my $t = $text{$type};
 433             my $message;
 434             if ($c == 1) {
 435                 $t =~ s/were/was/;
 436                 $message = sprintf "1 test case (%d%%) %s\n", 1 * 100 / $count, $t;
 437             } else {
 438                 $message = sprintf "%d test cases (%d%%) %s\n", $c, $c * 100 / $count, $t;
 439             }
 440             $message =~ s-\(0%\)-(<1%)-;
 441             print $message;
 442         }
 443     }
 444
 445     mkpath $testResultsDirectory;
 446
 447     open HTML, ">", $testResults or die;
 448     print HTML "<html>\n";
 449     print HTML "<head>\n";
 450     print HTML "<title>Layout Test Results</title>\n";
 451     print HTML "</head>\n";
 452     print HTML "<body>\n";
 453
 454     if ($counts{mismatch}) {
 455         print HTML "<p>Tests where results did not match expected results:</p>\n";
 456         print HTML "<table>\n";
 457         for my $test (@{$tests{mismatch}}) {
 458             my $base = $test;
 459             $base =~ s/\.(html|xml|xhtml|svg)$//;
 460             print HTML "<tr>\n";
 461             print HTML "<td><a href=\"$testDirectory/$test\">$base</a></td>\n";
 462             if (-s "$testResultsDirectory/$base-diffs.txt") {
 463                 print HTML "<td><a href=\"$testDirectory/$base-expected.txt\">expected</a></td>\n";
 464                 print HTML "<td><a href=\"$base-actual.txt\">actual</a></td>\n";
 465                 print HTML "<td><a href=\"$base-diffs.txt\">diffs</a></td>\n";
 466             } else {
 467                 print HTML "<td></td><td></td><td></td>\n";
 468             }
 469             if ($pixelTests) {
 470                 if ($imagesPresent{$base}) {
 471                     print HTML "<td><a href=\"$testDirectory/$base-expected.png\">expected image</a></td>\n";
 472                     print HTML "<td><a href=\"$base-diffs.html\">image diffs</a></td>\n";
 473                 } else {
 474                     print HTML "<td></td><td></td>\n";
 475                 }
 476             }
 477             print HTML "</tr>\n";
 478         }
 479         print HTML "</table>\n";
 480     }
 481
 482     if ($counts{fail}) {
 483         print HTML "<p>Tests that caused the DumpRenderTree tool to fail:</p>\n";
 484         print HTML "<table>\n";
 485         for my $test (@{$tests{fail}}) {
 486             my $base = $test;
 487             $base =~ s/\.(html|xml|xhtml|svg)$//;
 488             print HTML "<tr>\n";
 489             print HTML "<td><a href=\"$testDirectory/$test\">$base</a></td>\n";
 490             print HTML "</tr>\n";
 491         }
 492         print HTML "</table>\n";
 493     }
 494
 495     if ($counts{new}) {
 496         print HTML "<p>Tests that had no expected results (probably new):</p>\n";
 497         print HTML "<table>\n";
 498         for my $test (@{$tests{new}}) {
 499             my $base = $test;
 500             $base =~ s/\.(html|xml|xhtml|svg)$//;
 501             print HTML "<tr>\n";
 502             print HTML "<td><a href=\"$testDirectory/$test\">$base</a></td>\n";
 503             print HTML "<td><a href=\"$testDirectory/$base-expected.txt\">results</a></td>\n";
 504             if ($pixelTests && -f "$testDirectory/$base-expected.png") {
 505                 print HTML "<td><a href=\"$testDirectory/$base-expected.png\">image</a></td>\n";
 506             }
 507             print HTML "</tr>\n";
 508         }
 509         print HTML "</table>\n";
 510     }
 511
 512     print HTML "</body>\n";
 513     print HTML "</html>\n";
 514     close HTML;
 515
 516     system "WebKitTools/Scripts/run-safari", $testResults;
 517 }
 518
 519 sub printLeaks
 520 {
 521     my ($toolName, $toolPID, $leaksFilePath) = @_;
 522
 523     print "\n" unless $atLineStart;
 524     $atLineStart = 1;
 525
 526     # We are excluding the following reported leaks so they don't get in our way when looking for WebKit leaks:
 527     #
 528     #     pthread_create: false positive leak of 'THRD', Radar 3387783
 529     #     _CFPreferencesDomainDeepCopyDictionary: leak apparently in CFPreferences, Radar 4220786
 530     #
 531     # Note that this exclusion doesn't quite work right; sometimes a leak of 'THRD' with no stack trace will
 532     # still appear in the leaks output.
 533
 534     print " ? checking for leaks in $toolName\n";
 535     my $leaksOutput = `leaks -exclude pthread_create -exclude _CFPreferencesDomainDeepCopyDictionary $toolPID`;
 536     my ($count, $bytes) = $leaksOutput =~ /Process $toolPID: (\d+) leaks? for (\d+) total/;
 537     my ($excluded) = $leaksOutput =~ /(\d+) leaks? excluded/;
 538
 539     if ($count == 0 || ($excluded && $count <= $excluded)) {
 540         print " - no leaks found\n";
 541         unlink $leaksFilePath;
 542     } else {
 543         my $dir = $leaksFilePath;
 544         $dir =~ s|/[^/]+$|| or die;
 545         mkpath $dir;
 546
 547         print " + $count leaks ($bytes bytes) were found, details in $leaksFilePath\n";
 548         open LEAKS, ">", $leaksFilePath or die;
 549         print LEAKS $leaksOutput;
 550         close LEAKS;
 551     }
 552 }
 553
 554 # Break up a path into the directory (with slash) and base name.
 555 sub splitpath($)
 556 {
 557     my ($path) = @_;
 558
 559     return ($1, $2) if $path =~ m|^(.*/)([^/]+)$|;
 560     return ("", $path);
 561 }
 562
 563 # Sort first by directory, then by file, so all paths in one directory are grouped
 564 # rather than being interspersed with items from subdirectories.
 565 # Use numericcmp to sort directory and filenames to make order logical.
 566 sub pathcmp($$)
 567 {
 568     my ($patha, $pathb) = @_;
 569
 570     my ($dira, $namea) = splitpath($patha);
 571     my ($dirb, $nameb) = splitpath($pathb);
 572
 573     return numericcmp($dira, $dirb) if $dira ne $dirb;
 574     return numericcmp($namea, $nameb);
 575 }
 576
 577 # Sort numeric parts of strings as numbers, other parts as strings.
 578 # Makes 1.33 come before 1.3, which is cool.
 579 sub numericcmp($$)
 580 {
 581     my ($aa, $bb) = @_;
 582
 583     my @a = split /(\d+)/, $aa;
 584     my @b = split /(\d+)/, $bb;
 585
 586     # Compare one chunk at a time.
 587     # Each chunk is either all numeric digits, or all not numeric digits.
 588     while (@a && @b) {
 589         my $a = shift @a;
 590         my $b = shift @b;
 591
 592         # Use numeric comparison if chunks are non-equal numbers.
 593         return $a <=> $b if $a =~ /^\d/ && $b =~ /^\d/ && $a != $b;
 594
 595         # Use string comparison if chunks are any other kind of non-equal string.
 596         return $a cmp $b if $a ne $b;
 597     }
 598
 599     # One of the two is now empty; compare lengths for result in this case.
 600     return @a <=> @b;
 601 }