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