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;}}