1 #!/bin/sh
   2 #! -*- perl -*-
   3 # Generated automatically from SinceWhen.filepp by filepp version 1.7.1 on 2007-06-15
   4 
   5 #
   6 # Copyright (c) 2007, 2013, Oracle and/or its affiliates. All rights reserved.
   7 # DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
   8 #
   9 # This code is free software; you can redistribute it and/or modify it
  10 # under the terms of the GNU General Public License version 2 only, as
  11 # published by the Free Software Foundation.  Oracle designates this
  12 # particular file as subject to the "Classpath" exception as provided
  13 # by Oracle in the LICENSE file that accompanied this code.
  14 #
  15 # This code is distributed in the hope that it will be useful, but WITHOUT
  16 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  17 # FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  18 # version 2 for more details (a copy is included in the LICENSE file that
  19 # accompanied this code).
  20 #
  21 # You should have received a copy of the GNU General Public License version
  22 # 2 along with this work; if not, write to the Free Software Foundation,
  23 # Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA.
  24 #
  25 # Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA
  26 # or visit www.oracle.com if you need additional information or have any
  27 # questions.
  28 #
  29 
  30 eval 'exec perl -w -x -S $0 ${1+"$@"}'
  31     if 0;
  32 # line 7
  33 use 5.005_003;
  34 use strict;
  35 (my $myName = $0) =~ s@.*/@@;
  36 
  37 #----------------------------------------------------------------
  38 # Todo:
  39 # - if release N had only default nullary constructor, and N+1
  40 #   introduces an explicit nullary constructor, it should not have
  41 #   @since N+1.
  42 #----------------------------------------------------------------
  43 
  44 BEGIN {
  45   package Muse_Xform;
  46   use strict;
  47   use Exporter; @Muse_Xform::ISA = qw(Exporter);
  48 
  49 @Muse_Xform::EXPORT = qw(Xform);
  50 
  51 sub Xform(&;$) {local $_ = (@_ > 1) ? $_[1] : $_; &{$_[0]}(); $_}
  52 }
  53 BEGIN { import Muse_Xform };
  54 BEGIN {
  55   package Muse_Chomp;
  56   use strict;
  57   use Exporter; @Muse_Chomp::ISA = qw(Exporter);
  58 
  59 @Muse_Chomp::EXPORT = qw(Chomp);
  60 
  61 sub Chomp(;$) {chomp(my $line = (@_ ? $_[0] : $_)); $line}
  62 }
  63 BEGIN { import Muse_Chomp };
  64 BEGIN {
  65   package Muse_fileContents;
  66   use strict;
  67   use Exporter; @Muse_fileContents::ISA = qw(Exporter);
  68 
  69 @Muse_fileContents::EXPORT = qw(fileContents);
  70 
  71 sub fileContents($) {
  72   use Carp;
  73   my ($file) = @_;
  74   open FILE, "< $file" or confess "$file: $!\n";
  75   my $contents = "";
  76   while (1) {
  77     my $n = sysread FILE, $contents, 16384, length $contents;
  78     if (not defined $n) { close FILE; confess "$file $!\n"; }
  79     last if $n == 0;}
  80   close FILE;
  81   return $contents;}
  82 
  83 }
  84 BEGIN { import Muse_fileContents };
  85 BEGIN {
  86   package Muse_commandOutput;
  87   use strict;
  88   use Exporter; @Muse_commandOutput::ISA = qw(Exporter);
  89 # @author Martin Buchholz
  90 
  91 BEGIN {
  92   package Muse_shQuote;
  93   use strict;
  94   use Exporter; @Muse_shQuote::ISA = qw(Exporter);
  95 BEGIN { import Muse_Xform };
  96 
  97 @Muse_shQuote::EXPORT = qw(shQuote);
  98 
  99 sub shQuote(@) {
 100   join(' ',
 101        map {/^[a-zA-Z0-9.:,=@\/+_-]+$/ ? $_ :
 102               '"'.(Xform {s/([\\\`\"\$])/\\$1/gs;} $_).'"'}
 103        @_)}
 104 
 105 }
 106 BEGIN { import Muse_shQuote };
 107 
 108 @Muse_commandOutput::EXPORT = qw(commandOutput);
 109 
 110 my $usage = "Usage: commandOutput ([-rcOK, sub(\$) {...},] [-dir DIR,] \@command)\n";
 111 
 112 sub commandOutput {
 113   my ($rcOK, $dir);
 114   use Carp;
 115   while (@_ and $_[0] =~ /^-/) {
 116     my $opt = shift @_;
 117     if    ($opt eq "-rcOK")  {$rcOK = shift @_}
 118     elsif ($opt eq "-dir")   {$dir = shift @_}
 119     else {confess $usage}}
 120   defined (my $pid = open COMMAND_OUTPUT, "-|") or confess "Can't fork: $!\n";
 121   if ($pid == 0) { # Child
 122     if (defined $dir) {chdir $dir or confess "$dir: $!\n"}
 123     $^W=0; exec @_ or confess "Can't exec: @{[shQuote @_]}: $!\n"}
 124   my ($ret, @ret);
 125   if (wantarray) {@ret = <COMMAND_OUTPUT>} else {local $/ = undef; $ret = <COMMAND_OUTPUT>}
 126   waitpid($pid,0);
 127   if (defined $rcOK ? (not &{$rcOK}($?)) : ($? != 0)) {
 128     die "Command @{[shQuote @_]} failed: ".(($?&0xff) ? "signal ".($?&127)." (".(eval('use Config; (split(" ", $Config{sig_name}))[$?&127]') or '???').")" : "rc=".($?>>8))."\n"}
 129   close COMMAND_OUTPUT;
 130   return wantarray ? @ret : $ret;}
 131 
 132 }
 133 BEGIN { import Muse_commandOutput };
 134 BEGIN {
 135 
 136 #----------------------------------------------------------------
 137 package Set;
 138 # An experimental functional Set with operator overloading.
 139 # It's rather surprising how compact such an implementation can be.
 140 # As Mutable Companion to Set, simply use perl arrays.
 141 #----------------------------------------------------------------
 142 use strict;
 143 
 144 @Muse_Set::EXPORT = qw(new union intersect difference uniq);
 145 
 146 sub new(@) {my $class=shift; bless {map {($_,$_)} @_}, $class}
 147 sub of(@) {bless {map {($_,$_)} @_}}
 148 sub elts($) {values %{$_[0]}}   # Not the (stringified) keys!
 149 sub contains($$) {exists $_[0]->{$_[1]}}
 150 sub add($$) {bless {%{$_[0]},($_[1],$_[1])}}
 151 sub remove($$) {Set::of CORE::grep {$_ ne $_[1]} @{$_[0]}}
 152 sub toString($) {"[" . join(", ", $_[0]->elts) . "]"}
 153 sub size($) {scalar $_[0]->elts}
 154 sub isEmpty($) {$_[0]->size == 0}
 155 sub grep(&$) {Set::of CORE::grep {&{$_[0]}($_)} @{$_[1]}}
 156 sub map (&$) {Set::of CORE::map  {&{$_[0]}($_)} @{$_[1]}}
 157 sub each($) {(CORE::each %{$_[0]})[0]}
 158 sub sort($&) {CORE::sort {&{$_[1]}(\$a,\$b)} $_[0]->elts}
 159 sub isSubset($$) {my $other = ref $_[1] eq "Set" ? $_[1] : Set::of(@{$_[1]});
 160                   not grep {not exists $other->{$_}} @{$_[0]}}
 161 sub equals($$) {$_[0]->size == _size_($_[1]) and $_[0]->isSubset($_[1])}
 162 sub union(@) {Set::of map {@{$_}} @_}
 163 sub _size_($) {ref $_[0] eq "Set" ? $_[0]->size() : scalar @{$_[0]}}
 164 
 165 sub intersect(@) {
 166   my $count = scalar @_;
 167   my %hits = ();
 168   for my $elt (map {@{$_}} @_) {$hits{$elt}++}
 169   Set::of grep {$hits{$_} == $count} map {@{$_}} @_}
 170 
 171 sub difference(@) {
 172   my %difference = map {($_,$_)} @{shift()};
 173   delete @difference{map {@{$_}} @_};
 174   bless \%difference, "Set"}
 175 
 176 sub uniq(@) {@{Set::of @_}}
 177 
 178 use overload
 179   '""'  => sub {$_[0]->toString},
 180   bool  => sub {not $_[0]->isEmpty},
 181   '@{}' => sub {[$_[0]->elts]},
 182   '%{}' => sub {caller eq "Set" or die "Sets are not hashes!\n"; $_[0]},
 183   '+'   => sub {union @_[0,1]},
 184   '|'   => sub {union @_[0,1]},
 185   '&'   => sub {intersect @_[0,1]},
 186   '-'   => sub {difference @_[0,1]},
 187   '/'   => sub {difference @_[0,1]},
 188   '=='  => sub {equals $_[0],$_[1]},
 189   '!='  => sub {not $_[0] == $_[1]},
 190   fallback => 1;
 191 
 192 }
 193 BEGIN { import Set };
 194 BEGIN {
 195   package Muse_DirList;
 196   use strict;
 197   use Exporter; @Muse_DirList::ISA = qw(Exporter);
 198 
 199 @Muse_DirList::EXPORT = qw(DirList DirFiles);
 200 
 201 sub DirList($) {
 202   use Carp;
 203   my ($dir) = @_;
 204   opendir (DIR, $dir) or confess "$dir: $!";
 205   my @files = grep ($_ ne "." && $_ ne "..", readdir (DIR));
 206   closedir (DIR);
 207   return @files;}
 208 
 209 sub DirFiles(@) {map {my $dir = $_; map {"$dir/$_"} DirList $dir} @_}
 210 }
 211 BEGIN { import Muse_DirList };
 212 BEGIN {
 213   package Muse_dwimDocDir;
 214   use strict;
 215   use Exporter; @Muse_dwimDocDir::ISA = qw(Exporter);
 216 
 217 @Muse_dwimDocDir::EXPORT = qw(dwimDocDir dwimDocDirs docRoot);
 218 
 219 BEGIN {
 220   package Muse_j2seVariant;
 221   use strict;
 222   use Exporter; @Muse_j2seVariant::ISA = qw(Exporter);
 223 
 224 @Muse_j2seVariant::EXPORT = qw(j2seVariant j2seVariant64 j2seVariant6432 j2seVariants);
 225 
 226 my ($j2seVariant, $j2seVariant64);
 227 
 228 sub j2seVariant() {
 229   $j2seVariant ||= do {
 230     my $s = ($^O =~ /^(?:Windows|cygwin)/ ? "windows" : $^O);
 231     chomp (my $m = ($^O eq "solaris"  ? `/bin/uname -p` :
 232                     $^O eq "linux"    ? `/bin/uname -m` :
 233                     $^O eq "cygwin"   ? `/bin/uname -m` :
 234                     $^O =~ /^Windows/ ? `uname -m 2>/dev/null` :
 235                     die "Unknown operating system"));
 236 
 237     if    ($m =~ /x86_64/) {$m = "amd64"}
 238     elsif ($m =~ /86/)     {$m = "i586"}
 239     elsif ($m =~ /ia64/)   {$m = "ia64"}
 240 
 241     "$s-$m";}}
 242 
 243 sub j2seVariant64() {
 244   $j2seVariant64 ||=
 245     ($^O eq "solaris" and `/bin/isalist` =~ /\b(amd64|sparcv9)\b/) ?
 246       "solaris-$1" : undef;}
 247 
 248 sub j2seVariant6432() {j2seVariant64 or j2seVariant}
 249 
 250 sub j2seVariants() {(j2seVariant64 || (), j2seVariant)}
 251 }
 252 BEGIN { import Muse_j2seVariant qw(j2seVariant) };
 253 BEGIN {
 254   package Muse_Teamware;
 255   use strict;
 256   use Exporter; @Muse_Teamware::ISA = qw(Exporter);
 257 
 258 BEGIN {
 259   package Muse_SYS;
 260   use strict;
 261   use Exporter; @Muse_SYS::ISA = qw(Exporter);
 262 
 263 BEGIN { import Muse_shQuote };
 264 
 265 @Muse_SYS::EXPORT = qw(SYS);
 266 
 267 my $usage = "Usage: SYS ([-quiet,] [-rcOK, sub(\$) {...},] [-dir DIR,] \@command)\n";
 268 
 269 sub SYS {
 270   my ($quiet, $rcOK, $dir);
 271   use Carp;
 272   while (@_ and $_[0] =~ /^-/) {
 273     my $opt = shift @_;
 274     if    ($opt eq "-quiet") {$quiet = 1}
 275     elsif ($opt eq "-rcOK")  {$rcOK = shift @_}
 276     elsif ($opt eq "-dir")   {$dir = shift @_}
 277     else {confess $usage}}
 278   do { local $| = 1; print "==> @{[shQuote @_]}\n"; } unless defined $quiet;
 279   defined (my $pid = fork()) or confess "Can't fork: $!\n";
 280   if ($pid == 0) { # Child
 281     if (defined $dir) {chdir $dir or confess "$dir: $!\n"}
 282     $^W=0; exec @_ or confess "Can't exec @{[shQuote @_]}: $!\n"}
 283   waitpid($pid,0);
 284   if (defined $rcOK ? (not &{$rcOK}($?)) : ($? != 0)) {
 285     confess "Command @{[shQuote @_]} failed: ".(($?&0xff) ? "signal ".($?&127)." (".(eval('use Config; (split(" ", $Config{sig_name}))[$?&127]') or '???').")" : "rc=".($?>>8))."\n"}}
 286 }
 287 BEGIN { import Muse_SYS };
 288 BEGIN { import Muse_Xform };
 289 BEGIN { import Muse_Chomp };
 290 BEGIN { import Set };
 291 BEGIN { import Muse_commandOutput };
 292 
 293 @Muse_Teamware::EXPORT = qw(SCCSRevisions sFile pFile parseFilename SccsEdit SccsGet SccsCreate SccsDelget checkWorkspace checkDir twSplitPath wsRoot j2seWsSplitPath j2seWsRoot wsParent wsChildren);
 294 
 295 use Carp;
 296 
 297 sub SCCSRevisions($) {
 298   my ($sFile) = @_;
 299   open SFILE, "< $sFile" or confess "$sFile: $!\n";
 300   my @revisions = ();
 301   local $_;
 302   my $accum;
 303   my $subCode;
 304   while (<SFILE>) {
 305     my ($code, $data) = /^\01(.) *(.*\n)/;
 306     next if not defined $code;
 307     last if $code =~ /^[fuUtTIDE]/; # see sccsfile(4) for details
 308     if ($code eq 's') {$accum = $data}
 309     if ($code eq 'd' and
 310         # ^Ad type sid yr/mo/da hr:mi:se username serial-number prev-sn
 311         $data =~ /^([DR]) [0-9.]+\s+(\d{2}\/\d{2}\/\d{2}\s+\d{2}:\d{2}:\d{2}\s+\S+)/) {
 312         $subCode = $1;
 313         $accum .= "$1 $2\n"}
 314     if ($code eq 'c') {$accum .= $data}
 315     if ($code eq 'e') {
 316       if ($subCode eq 'D') {
 317         push @revisions, $accum}
 318       elsif ($subCode eq 'R') {
 319         push @revisions, ($accum =~ /(Name history.*\n)/gm)}
 320       $subCode = $accum = undef;}
 321   }
 322   Set::of(@revisions)}
 323 
 324 sub sFile($) {Xform {s:([^/]+)$:SCCS/s.$1:} $_[0]}
 325 sub pFile($) {Xform {s:([^/]+)$:SCCS/p.$1:} $_[0]}
 326 
 327 sub parseFilename($) {
 328   my ($file) = @_;
 329   my ($dirname, $basename) = ($file =~ m:^(.*?)([^\\/]+)$:);
 330   $dirname = "." if $dirname eq "";
 331   return ($dirname, $basename);}
 332 
 333 sub SccsEdit($) {
 334   my ($file) = @_;
 335   if (! -w $file) {
 336     my ($dirname, $basename) = parseFilename $file;
 337     SYS "-dir", $dirname, "sccs", "edit", $basename;}}
 338 
 339 sub SccsGet($) {
 340   my ($file) = @_;
 341   my ($dirname, $basename) = parseFilename $file;
 342   SYS "-dir", $dirname, "get", "SCCS/s.$basename";}
 343 
 344 sub SccsCreate($$) {
 345   my ($file, $comment) = @_;
 346   my ($dirname, $basename) = parseFilename $file;
 347   SYS "admin", "-fb", "-y$comment", "-i${file}", sFile($file);
 348   SYS "mv", $file, "${file}.${myName}";
 349   SccsGet $file;
 350   SYS "rm", "-f", "${file}.${myName}";}
 351 
 352 sub SccsDelget($$) {
 353   my ($file, $comment) = @_;
 354   my ($dirname, $basename) = parseFilename $file;
 355   SYS "-dir", $dirname, "sccs", "delget", "-y$comment", $basename;}
 356 
 357 sub predSplitPath(&$$) {
 358   use File::Spec;
 359   my ($pred, $file, $desc) = @_;
 360   $file =~ s:(?<!/)/$::;
 361   $file = File::Spec->rel2abs($file) if $file !~ /^\//;
 362   return ($file,"") if &{$pred}($file);
 363   for (my $i = length($file)+1; $i != -1; $i = rindex($file,"/",$i-1)) {
 364     my $dir = substr($file,0,$i);
 365     if (&{$pred}($dir)) { return ($dir, substr($file,$i+1))}}
 366   confess "Can't find $desc for $file\n";}
 367 
 368 sub twSplitPath($) {
 369   predSplitPath {-d "$_[0]/Codemgr_wsdata"} $_[0], "Teamware workspace root"}
 370 
 371 sub j2seWsSplitPath($) {
 372   predSplitPath {-r "$_[0]/make/common/Defs.gmk"} $_[0], "j2se workspace root"}
 373 
 374 sub j2seWsRoot($) {(j2seWsSplitPath($_[0]))[0]}
 375 
 376 # sub twSplitPath($) {
 377 #   use File::Spec;
 378 #   my ($file) = @_;
 379 #   $file =~ s:(?<!/)/$::;
 380 #   $file = File::Spec->rel2abs($file) if $file !~ /^\//;
 381 #   return ($file,"") if -d "$file/Codemgr_wsdata";
 382 #   for (my $i = length($file)+1; $i != -1; $i = rindex($file,"/",$i-1)) {
 383 #     my $dir = substr($file,0,$i);
 384 #     if (-d "$dir/Codemgr_wsdata") { return ($dir, substr($file,$i+1))}}
 385 #   confess "Can't find workspace root for $file\n";}
 386 
 387 sub checkWorkspace(@) {
 388   for my $w (@_) {
 389     -d "$w/Codemgr_wsdata" or confess "$w is not a Teamware workspace\n"}}
 390 
 391 sub checkDir(@) {
 392   my @dir = (@_ ? @_ : ($_));
 393   for my $dir (@dir) {-d $dir or confess "$dir is not a directory"}
 394   return @dir}
 395 
 396 sub wsRoot($) {(twSplitPath($_[0]))[0]}
 397 
 398 sub wsParent($) {
 399   my $parent = Chomp commandOutput("workspace", "parent", wsRoot $_[0]);
 400   checkDir $parent;
 401   return $parent}
 402 
 403 sub wsChildren($) {map {Chomp $_} `workspace children @{[wsRoot $_[0]]}`}
 404 }
 405 BEGIN { import Muse_Teamware qw(wsRoot wsParent) };
 406 
 407 sub isDocDir($) {-r "$_[0]/overview-tree.html"}
 408 
 409 sub docRoot($) {
 410   my ($dir) = @_;
 411   for (;;) {
 412     die "Can't find doc root for $_[0]\n"
 413       if $dir eq "" || $dir eq "/";
 414     return $dir if isDocDir $dir;
 415     $dir =~ s~/[^/]*\z~~;}}
 416 
 417 #----------------------------------------------------------------
 418 # Dwim a doc tree from a specification.
 419 # Each tree may actually be a docs directory (containing an
 420 # `overview-summary.html') or a directory in a Teamware workspace
 421 # containing such a docs directory, or a JDK version number such as
 422 # 1.5.0.
 423 #----------------------------------------------------------------
 424 sub dwimDocDir($) {
 425   my ($doc) = @_;
 426   $doc =~ s~(?<!/)/$~~;
 427   my $x;
 428 
 429   for my $dir ("$doc", "$doc/api", "$doc/docs/api", "$doc/doc/api") {
 430     return $dir if isDocDir $dir}
 431 
 432   if ($doc =~ /^[0-9][0-9.]*$/) {
 433     if (-d (my $reDir = "/java/re/jdk/$doc")) {
 434       for my $path ("archive/fcs/docs/api", "archive/fcs/doc/api",
 435                     "latest/docs/api", "latest/doc/api",
 436                     "archive/W/doc/api") {
 437         return $x if isDocDir($x = "$reDir/$path")}}}
 438 
 439   for my $w ("$doc", "$ENV{HOME}/ws/$doc") {
 440     if (-d $w && defined (my $wsRoot = eval { wsRoot $w })) {
 441       for my $d (qw(docs doc)) {
 442         return $x if isDocDir($x = "$wsRoot/build/@{[j2seVariant]}/$d/api")}}}
 443 
 444   die "Can't find docs dir corresponding to \`$doc'\n";}
 445 
 446 #----------------------------------------------------------------
 447 # Dwim a pair of doc trees from a pair of specs.
 448 # The first argument defaults to `.' and the second defaults to the doc
 449 # tree in the parent of the workspace (if any) containing the first.
 450 #----------------------------------------------------------------
 451 sub dwimDocDirs(@) {
 452   my ($child, $parent) = @_;
 453   my $childDoc  = dwimDocDir($child || ".");
 454   my $parentDoc = dwimDocDir($parent || wsParent $childDoc);
 455   return ($childDoc, $parentDoc);}
 456 }
 457 BEGIN { import Muse_dwimDocDir };
 458 
 459 my $usage="Usage: $myName [options...] [DOC-TREE]
 460 
 461 Finds missing or incorrect \@since tags in DOC-TREE, for methods
 462 added relative to (older) doc trees.
 463 
 464 Dwimmery is used to intuit DOC-TREE.  The tree may be a docs directory
 465 \(containing an \`overview-summary.html') or a directory in a Teamware
 466 workspace containing such a docs directory built using \`make docs',
 467 or a JDK version number such as \"1.5.0\".  DOC-TREE defaults to \`.'.
 468 
 469 I usually run $myName like this:
 470 $myName 6.0
 471 
 472 Options:
 473 -verbose     Print more details
 474 -classes=RE  Only check class names matching regular expression RE
 475 ";
 476 
 477 my $classNameFilter = '.';
 478 my $debug = undef;
 479 my $verbose = undef;
 480 
 481 use Getopt::Long ();
 482 Getopt::Long::Configure "no_ignore_case";
 483 Getopt::Long::GetOptions
 484   ("debug"     => \$debug,
 485    "verbose"   => \$verbose,
 486    "classes=s" => \$classNameFilter,
 487    "help|?"    => sub {print $usage; exit 0},
 488   ) or die $usage;
 489 
 490 die $usage if @ARGV > 1;
 491 my $tree = dwimDocDir(shift || ".");
 492 
 493 my $treeVersion = new HtmlFile("$tree/java/lang/Object.html")->javaVersion
 494   or die "Can't find JDK version for $tree\n";
 495 print "JDK version of \"$tree\" is $treeVersion\n" if $verbose;
 496 
 497 # Returns the JDK version of the preceding feature release
 498 sub sub1($) {
 499   use Carp;
 500   my ($version) = @_;
 501   my ($major, $minor) = ($version =~ m~^(\d+)\.(\d+)~)
 502     or confess "Bad version format\n";
 503   "${major}.".($minor-1);}
 504 
 505 # Finds all preceding JDK versions >= 1.2 and corresponding doc trees
 506 my @oldVersions = ();
 507 my %docDir;
 508 for (my $version = sub1 $treeVersion;
 509      $version ne "1.1";
 510      $version = sub1 $version) {
 511   push @oldVersions, $version;
 512   # Find latest so-called dot release for $version
 513   $docDir{$version} =
 514     dwimDocDir ((sort {$b cmp $a}
 515                  grep {/\Q$version\E\.\d+$/}
 516                  DirList "/java/re/jdk")[0])
 517       or confess "Can't find doc dir for JDK $version\n";
 518 }
 519 
 520 print "Using doc trees:\n".
 521   join '', map {"\t$_\n"} $tree, map {$docDir{$_}} @oldVersions
 522   if $verbose;
 523 
 524 # The main difficulty in extracting new method signatures from html
 525 # files is generification.  A generified method is not an "added"
 526 # method.  Furthermore, there is a bug in javadoc in Tiger and builds
 527 # of Mustang < b61
 528 #
 529 # 6290760: javadoc thinks <T> f(T[]) erases to f(Object) instead of f(Object[])
 530 #
 531 # which means that we need to treat the following as possibly equivalent:
 532 # f(T[])
 533 # f(Object[])
 534 # f(Object)
 535 #
 536 # Vararg and gratuitous whitespace changes in the generated html are
 537 # other things to be careful about.
 538 
 539 {
 540   package MethodDef;
 541   BEGIN { import Set };
 542 
 543   use constant SIGNATURES => 0;
 544   use constant SINCE      => 1;
 545 
 546   # Returns a Set of signatures for the method.  Multiple signatures
 547   # are returned only in the presence of generics, in which case the
 548   # first signature is the most human-preferred generified signature.
 549   sub _signatures($) {
 550     my ($methodHtml) = @_;
 551     die unless ($methodHtml =~ m~^((?:<A NAME="([^\"]+)"><!-- --></A>)+)~);
 552     my @sigs = ($1 =~ m~A NAME=\"([^\"]+)\"~g);
 553     die "Unexpected multiplicity of signatures: @sigs\n" if @sigs > 2;
 554     @sigs = map {HtmlFile::_canonicalizeMethodName $_} @sigs;
 555     @sigs = reverse @sigs if @sigs == 2;  # Prefer generic, second sig
 556     return [@sigs];}
 557 
 558   sub since($)      {$_[0]->[SINCE]}
 559   sub signatures($) {$_[0]->[SIGNATURES]}
 560   sub signature($)  {$_[0]->[SIGNATURES]->[0]}
 561   sub isGeneric($)  {@{$_[0]->[SIGNATURES]} == 2}
 562   sub erasedSig($)  {my @x = @{$_[0]->[SIGNATURES]}; $x[$#x]}
 563 
 564   sub new(@) {
 565     my ($class, $methodHtml) = @_;
 566     my @fields = ();
 567     $fields[SIGNATURES] = _signatures $methodHtml;
 568     $fields[SINCE]      = HtmlFile::_htmlSince($methodHtml);
 569     bless [@fields], $class}
 570 }
 571 
 572 {
 573   # This package represents the reverse engineering of
 574   # javadoc-generated html; you need to look at such html to
 575   # understand/debug this.
 576   package HtmlFile;
 577   BEGIN { import Set };
 578   BEGIN { import Muse_Xform };
 579   BEGIN { import Muse_fileContents };
 580 BEGIN {
 581   package Muse_parseFilename;
 582   use strict;
 583   use Exporter; @Muse_parseFilename::ISA = qw(Exporter);
 584 
 585 @Muse_parseFilename::EXPORT = qw(parseFilename);
 586 
 587 sub parseFilename($) {
 588   my ($file) = @_;
 589   use Carp;
 590   if ($^O eq "cygwin") {
 591     return (".", $file) if $file !~ m,[\\/],;
 592     $file =~ tr [\\][/];
 593     confess "parseFilename: $file: root directories have no dirnames\n"
 594       if $file =~ m,^(:?[A-Za-z];)?/?$,;}
 595   else {
 596     return (".", $file) if $file !~ m,/,;
 597     $file =~ s,/+,/,g;
 598     confess "parseFilename: $file: root directories have no dirnames\n"
 599       if $file eq "/";}
 600   $file =~ s,/$,,;
 601   return ($file =~ m,^(.*)/([^/]+)$,);}
 602 }
 603   BEGIN { import Muse_parseFilename };
 604 
 605   use constant FILENAME     => 0; # Name of html file for this class
 606   use constant JAVA_VERSION => 1; # E.g. 1.5
 607   use constant CLASS_SINCE  => 2; # When class was added, or undef
 608   use constant METHODDEFS   => 3; # Set of MethodDefs defined in this class
 609   use constant SIGNATURES   => 4; # Set of signatures defined in this class
 610   use constant INHERITED    => 5; # Set of signatures inherited from ancestors
 611   use constant HTML         => 6; # Complete contents of html file
 612 
 613   sub _htmlSince($) {
 614     my ($methodHtml) = @_;
 615     $methodHtml =~ m~<DT><B>Since:</B></DT>[ \n]*<DD>(?:JDK *)?(1.\d)</DD>~; return $1}
 616 
 617   sub _canonicalizeMethodName($) {
 618     local $_ = $_[0];
 619     s~\.\.\.~[]~g;   # De-sugar Vararg syntax
 620     tr~ ~~d;         # Spaces were added after commas, starting with 1.5.0
 621     $_}
 622 
 623   sub _htmlForSection($$) {
 624     my ($contents, $sectionName) = @_;
 625     my ($html) = ($contents =~ m~^<!-- =+ \Q$sectionName\E =+ -->\n((?:.*\n)+?)(?=^<!-- =+ .* =+ -->\n|\z)~m);
 626     defined $html ? $html : ""}
 627 
 628   sub _sectionElements($$) {
 629     my ($contents, $sectionName) = @_;
 630     Set::of
 631         grep {not /\A<A NAME="(?:method|field|constructor|enum_constant|annotation_type_element)_detail">/}
 632           _htmlForSection($contents, $sectionName)
 633             =~ /^(<A NAME="[^"]+"><!-- -->(?:(?:.*\n)+?))(?=<HR>|<A NAME|\z)/mg}
 634 
 635 #   sub _sectionMethods($$) {
 636 #     my ($contents, $title) = @_;
 637 #     Set::of
 638 # #     grep {/^<A NAME="[^"]+\(/g}
 639 #       grep {/^<A NAME="[^"]+"/g}
 640 #         split m~(?=^<A NAME=")~m,
 641 #           _htmlForSection $contents, $title}
 642 
 643   {
 644     my %signatures;
 645 
 646     sub __signatures($) {
 647       my ($filename) = @_;
 648       1 while $filename =~ s~/([^./][^/]+)/\.\./~/~; # Canonicalize
 649       $signatures{$filename} ||= new HtmlFile($filename)->signatures;}
 650   }
 651 
 652   sub _inherited($) {
 653     my ($self) = @_;
 654     my ($dirname, $basename) = parseFilename $self->filename;
 655     Set::union
 656         map {__signatures "$dirname/$_"}
 657           map {m~<A HREF="([^"]+)#[^"]+"~g}
 658             ((_htmlForSection $self->[HTML], "METHOD SUMMARY") =~
 659              m~<A NAME="methods_inherited_from_(?:class|interface)_[^"]+"><!-- --></A>\n<TABLE(.*?)</TABLE>~gs)}
 660 
 661   sub _methodDefs($) {
 662     my ($contents) = @_;
 663     Set::of
 664         map {new MethodDef $_}
 665           map {@{_sectionElements($contents, $_)}}
 666             "CONSTRUCTOR DETAIL", "METHOD DETAIL", "FIELD DETAIL"}
 667 
 668   sub _signatures($) {Set::map {@{$_->signatures}} $_[0]->methodDefs}
 669 
 670   sub _javaVersion($) {
 671     my ($self) = @_;
 672     $self->[HTML] =~ m~^<!-- Generated by javadoc \(build (1.[0-9])~m;
 673     defined $1 ? $1 : ""}
 674 
 675   sub _classSince($) {
 676     my ($self) = @_;
 677     _htmlSince _htmlForSection $self->[HTML], "START OF CLASS DATA"}
 678 
 679   sub new(@) {
 680     my ($class, $htmlFile) = @_;
 681     my $contents = fileContents($htmlFile);
 682     my @fields = ();
 683     $fields[FILENAME]   = $htmlFile;
 684     $fields[METHODDEFS] = _methodDefs $contents;
 685     $fields[HTML]       = $contents;
 686     bless [@fields], $class}
 687 
 688   sub filename($)    {$_[0]->[FILENAME]}
 689   sub javaVersion($) {$_[0]->[JAVA_VERSION] ||= _javaVersion $_[0]}
 690   sub classSince($)  {$_[0]->[CLASS_SINCE]  ||= _classSince  $_[0]}
 691   sub signatures($)  {$_[0]->[SIGNATURES]   ||= _signatures  $_[0]}
 692   sub inherited($)   {$_[0]->[INHERITED]    ||= _inherited   $_[0]}
 693   sub methodDefs($)  {$_[0]->[METHODDEFS]}
 694 
 695   sub className($) {
 696     $_[0]->[FILENAME] =~ m~/api/(.*)\.html$~;
 697     Xform {tr[/][.]} $1}
 698 
 699   # Does this class include or inherit a definition for METHODDEF?
 700   sub defines($$) {
 701     my ($self, $methodDef) = @_;
 702     my $sig = $methodDef->erasedSig;
 703 
 704     (($self->signatures->contains($sig))
 705      or                 # Note lazy evaluation here
 706      ($self->inherited->contains($sig))
 707      or                 # More lazyness...
 708      # Workaround for 6290760: javadoc thinks <T> f(T[]) erases to f(Object)...
 709      ($methodDef->isGeneric
 710       and
 711       (Set::map {Xform {tr~[]~~d}} ($self->signatures + $self->inherited))
 712       ->contains(Xform {tr~[]~~d} $sig)))}
 713 #   sub defines($$) {
 714 #     my ($self, $methodDef) = @_;
 715 #     my $sig = $methodDef->erasedSig;
 716 
 717 #     (($self->signatures->contains($sig))
 718 #      or                       # Note lazy evaluation here
 719 #      # Workaround for 6290760: javadoc thinks <T> f(T[]) erases to f(Object)...
 720 #      ($methodDef->isGeneric
 721 #       and
 722 #       (Set::map {Xform {tr~[]~~d}} ($self->signatures))
 723 #       ->contains(Xform {tr~[]~~d} $sig)))}
 724 }
 725 
 726 my @find = ("find", $tree, "-name", "*.html", "-print");
 727 for my $htmlFile (grep {not m~\Q$tree\E.*-~ and m~$classNameFilter~}
 728                   map {Chomp $_} commandOutput @find) {
 729   next if $htmlFile =~ m~/org/w3c/dom/~;
 730   next if $htmlFile =~ m~/org/xml/sax/~;
 731   my $n = new HtmlFile($htmlFile);
 732   # Ignore files not generated by javadoc
 733   next if not (my $javaVersion = $n->javaVersion);
 734   my $methodDefs = $n->methodDefs;
 735   my $prevVersion = $javaVersion;
 736   my %since;
 737   for my $version (@oldVersions) {
 738     my $docDir = $docDir{$version};
 739     my $oldHtmlFile =  Xform {s/^\Q$tree\E/$docDir/} $htmlFile;
 740     if (! -r $oldHtmlFile) {
 741       # This class was introduced in the previously examined version
 742       my $realVersion = $prevVersion;
 743       if (-d Xform {s~[^/]+$~~} $oldHtmlFile) { # Ignore added packages
 744         my $report = sub($) {
 745           printf "%s for class %s\n%s",
 746             $_[0], $n->className, ($verbose ? "\t$htmlFile\n" : "")};
 747         if (not defined (my $since = $n->classSince)) {
 748           &$report("Missing \"\@since $realVersion\"")}
 749         elsif ($since ne $realVersion) {
 750           &$report("Incorrect \"\@since $since\" (should be $realVersion)")}}
 751       last;}
 752     else {
 753       sub isDefaultConstructor($$) {
 754         my ($className, $signature) = @_;
 755         my $simpleName = Xform {s~.*\.~~} $className;
 756         # warn "$simpleName $signature\n";
 757         $signature =~ m~\Q$simpleName\E\(\)$~;}
 758       my $o = new HtmlFile($oldHtmlFile);
 759       for my $methodDef (grep {not defined $since{$_} and not $o->defines($_)}
 760                          @{$methodDefs}) {
 761         next if isDefaultConstructor($n->className, $methodDef->signature);
 762         my $realVersion = $prevVersion;
 763         $since{$methodDef} = $realVersion;
 764         my $report = sub($) {
 765           printf "%s for member %s.%s\n%s",
 766             $_[0], $n->className, $methodDef->signature,
 767               ($verbose ? "\t".$n->filename."\n\t".$o->filename."\n" : "")};
 768         if (! defined $methodDef->since) {
 769           &$report("Missing \"\@since $realVersion\"")}
 770         elsif ($methodDef->since ne $realVersion) {
 771           &$report("Incorrect \"\@since ".$methodDef->since."\" (should be $realVersion)")}}}
 772     $prevVersion = $version;}}