WebKitTools/Scripts/prepare-ChangeLog

   1 #!/usr/bin/perl -w
   2 # -*- Mode: perl; indent-tabs-mode: nil; c-basic-offset: 2  -*-
   3
   4 #
   5 #  Copyright (C) 2000, 2001 Eazel, Inc.
   6 #  Copyright (C) 2002, 2003 Apple Computer, Inc.
   7 #
   8 #  prepare-ChangeLog is free software; you can redistribute it and/or
   9 #  modify it under the terms of the GNU General Public
  10 #  License as published by the Free Software Foundation; either
  11 #  version 2 of the License, or (at your option) any later version.
  12 #
  13 #  prepare-ChangeLog is distributed in the hope that it will be useful,
  14 #  but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16 #  General Public License for more details.
  17 #
  18 #  You should have received a copy of the GNU General Public
  19 #  License along with this program; if not, write to the Free
  20 #  Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  21 #
  22
  23
  24 # Perl script to create a ChangeLog entry with names of files
  25 # and functions from a cvs diff.
  26 #
  27 # Darin Adler <darin@bentspoon.com>, started 20 April 2000
  28 # Java support added by Maciej Stachowiak <mjs@eazel.com>
  29 # Objective-C, C++ and Objective-C++ support added by Maciej Stachowiak <mjs@apple.com>
  30
  31
  32 #
  33 # TODO:
  34 #   List functions that have been removed too.
  35 #   Decide what a good logical order is for the changed files
  36 #     other than a normal text "sort" (top level first?)
  37 #     (group directories?) (.h before .c?)
  38 #   Handle yacc source files too (other languages?).
  39 #   Help merge when there are ChangeLog conflicts or if there's
  40 #     already a partly written ChangeLog entry.
  41 #   Add command line option to put the ChangeLog into a separate
  42 #     file or just spew it out stdout.
  43 #   Figure out how to allow -z options from .cvsrc to work without
  44 #     letting other bad options work. Currently the -f disables
  45 #     everything from the .cvsrc.
  46 #   Add CVS version numbers for each file too (can't do that until
  47 #     the changes are checked in, though).
  48 #   Work around diff stupidity where deleting a function that starts
  49 #     with a comment makes diff think that the following function
  50 #     has been changed (if the following function starts with a comment
  51 #     with the same first line, such as /**)
  52 #   Work around diff stupidity where deleting an entire function and
  53 #     the blank lines before it makes diff think you've changed the
  54 #     previous function.
  55
  56 use strict;
  57
  58 use Getopt::Long;
  59
  60 my $spewDiff = $ENV{"PREPARE_CHANGELOG_DIFF"};
  61 my $openChangeLogs = 0;
  62 GetOptions("diff|d!" => \$spewDiff,
  63            "open|o!" => \$openChangeLogs);
  64
  65 # Find the list of modified files
  66 my @changed_files;
  67 my $changed_files_string;
  68 my %changed_line_ranges;
  69 my %function_lists;
  70 my @conflict_files;
  71
  72 my $CVS = "cvs";
  73
  74 print STDERR "  Running cvs -n update to find changed, added, or removed files.\n";
  75 open UPDATE, "$CVS -qn update 2> /dev/stdout |" or die "The cvs update failed: $!.\n";
  76 while (<UPDATE>)
  77   {
  78     if (/^[MA] (.+)$/)
  79       {
  80         my $file = $1;
  81         $function_lists{$file} = "";
  82         push @changed_files, $file if $file ne "ChangeLog" && $file !~ /\.nib$/;
  83       }
  84
  85     push @conflict_files, $1 if /^[C] (.+)$/;
  86
  87     $function_lists{$1} = " Added." if /^A (.+)$/;
  88     $function_lists{$1} = " Removed." if /^R (.+)$/;
  89
  90     print unless /^[A-Z] ./ || /^cvs server: New directory/;
  91   }
  92 close UPDATE;
  93
  94 if (@conflict_files)
  95   {
  96     print STDERR "  The following files have conflicts. Run prepare-ChangeLog again after fixing the conflicts:\n";
  97     print STDERR join("\n", @conflict_files), "\n";
  98     exit 1;
  99   }
 100
 101 if (@changed_files)
 102   {
 103     $changed_files_string = "'" . join ("' '", @changed_files) . "'";
 104
 105     # For each file, build a list of modified lines.
 106     # Use line numbers from the "after" side of each diff.
 107     print STDERR "  Running cvs diff to determine which lines changed.\n";
 108     my $file;
 109     open DIFF, "$CVS -fq diff -N $changed_files_string |" or die "The cvs diff failed: $!.\n";
 110     while (<DIFF>)
 111       {
 112         $file = $1 if /^Index: (\S+)$/;
 113         if (defined $file) {
 114           if (/^\d+(,\d+)?[acd](\d+)(,(\d+))?/)
 115             { push @{$changed_line_ranges{$file}}, [ $2, $4 || $2 ]; }
 116           elsif (/DO_NOT_COMMIT/) {
 117             print STDERR "WARNING: file $file contains the string DO_NOT_COMMIT, line $.\n";
 118           }
 119         }
 120       }
 121     close DIFF;
 122   }
 123
 124 # For each source file, convert line range to function list.
 125 if (%changed_line_ranges)
 126   {
 127     print STDERR "  Extracting affected function names from source files.\n";
 128     foreach my $file (keys %changed_line_ranges)
 129       {
 130         # Only look for function names in .c files.
 131         next unless $file =~ /\.(c|cpp|m|mm|h|java)/;
 132
 133         # Find all the functions in the file.
 134         open SOURCE, $file or next;
 135         my @function_ranges = get_function_line_ranges(\*SOURCE, $file);
 136         close SOURCE;
 137
 138         # Find all the modified functions.
 139         my @functions;
 140         my %saw_function;
 141         my @change_ranges = (@{$changed_line_ranges{$file}}, []);
 142         my @change_range = (0, 0);
 143         FUNCTION: foreach my $function_range_ref (@function_ranges)
 144           {
 145             my @function_range = @$function_range_ref;
 146
 147             # Advance to successive change ranges.
 148             for (;; @change_range = @{shift @change_ranges})
 149               {
 150                 last FUNCTION unless @change_range;
 151
 152                 # If past this function, move on to the next one.
 153                 next FUNCTION if $change_range[0] > $function_range[1];
 154
 155                 # If an overlap with this function range, record the function name.
 156                 if ($change_range[1] >= $function_range[0]
 157                     and $change_range[0] <= $function_range[1])
 158                   {
 159                     if (!$saw_function{$function_range[2]})
 160                       {
 161                         $saw_function{$function_range[2]} = 1;
 162                         push @functions, $function_range[2];
 163                       }
 164                     next FUNCTION;
 165                   }
 166               }
 167           }
 168
 169         # Format the list of functions now.
 170
 171         if (@functions) {
 172             $function_lists{$file} = "" if !defined $function_lists{$file};
 173             $function_lists{$file} .= "\n        (" . join("):\n        (", @functions) . "):";
 174         }
 175       }
 176   }
 177
 178 if (!%function_lists)
 179   {
 180     print STDERR "  No changes found.\n";
 181     exit 1;
 182   }
 183
 184 # Get some parameters for the ChangeLog we are about to write.
 185 my $date = sprintf "%d-%02d-%02d",
 186   1900 + (localtime $^T)[5], # year
 187   1 + (localtime $^T)[4], # month
 188   (localtime $^T)[3]; # day within month
 189 my $name = $ENV{CHANGE_LOG_NAME}
 190   || $ENV{REAL_NAME}
 191   || (getpwuid $<)[6]
 192   || "set REAL_NAME environment variable";
 193 my $email_address = $ENV{CHANGE_LOG_EMAIL_ADDRESS}
 194   || $ENV{EMAIL_ADDRESS}
 195   || "set EMAIL_ADDRESS environment variable";
 196
 197 # Remove trailing parenthesized notes from user name (bit of hack).
 198 $name =~ s/\(.*?\)\s*$//g;
 199
 200 # Find the change logs.
 201 my %has_log;
 202 my %files;
 203 foreach my $file (sort keys %function_lists)
 204   {
 205     my $prefix = $file;
 206     my $has_log = 0;
 207     while ($prefix)
 208       {
 209         $prefix =~ s-/[^/]+/?$-/- or $prefix = "";
 210         $has_log = $has_log{$prefix};
 211         if (!defined $has_log)
 212           {
 213             $has_log = -f "${prefix}ChangeLog";
 214             $has_log{$prefix} = $has_log;
 215           }
 216         last if $has_log;
 217       }
 218     if (!$has_log)
 219       {
 220         print STDERR "No ChangeLog found for $file.\n";
 221       }
 222     else
 223       {
 224         push @{$files{$prefix}}, $file;
 225       }
 226   }
 227
 228 # Get the latest ChangeLog files from cvs.
 229 my $logs = "";
 230 foreach my $prefix (sort keys %files)
 231   {
 232     $logs .= " ${prefix}ChangeLog";
 233   }
 234 if ($logs)
 235   {
 236     print STDERR "  Running cvs update to update ChangeLog files.\n";
 237     open ERRORS, "$CVS update$logs |" or die "The cvs update of ChangeLog files failed: $!.\n";
 238     print STDERR "    $_" while <ERRORS>;
 239     close ERRORS;
 240   }
 241
 242 # Write out a new ChangeLog file.
 243 foreach my $prefix (sort keys %files)
 244   {
 245     print STDERR "  Editing the ${prefix}ChangeLog file.\n";
 246     open OLD_CHANGE_LOG, "${prefix}ChangeLog" or die "Could not open ${prefix}ChangeLog file: $!.\n";
 247     # It's less efficient to read the whole thing into memory than it would be
 248     # to read it while we prepend to it later, but I like doing this part first.
 249     my @old_change_log = <OLD_CHANGE_LOG>;
 250     close OLD_CHANGE_LOG;
 251     open CHANGE_LOG, "> ${prefix}ChangeLog" or die "Could not write ${prefix}ChangeLog\n.";
 252     print CHANGE_LOG "$date  $name  <$email_address>\n\n";
 253     print CHANGE_LOG "        Reviewed by NOBODY (OOPS!).\n\n";
 254     if ($prefix =~ m/WebCore/ || `pwd` =~ m/WebCore/) {
 255         print CHANGE_LOG "        Test cases added: (NONE)\n\n";
 256     }
 257
 258     foreach my $file (sort @{$files{$prefix}})
 259       {
 260         my $file_stem = substr $file, length $prefix;
 261         print CHANGE_LOG "        * $file_stem:$function_lists{$file}\n";
 262       }
 263     print CHANGE_LOG "\n", @old_change_log;
 264     close CHANGE_LOG;
 265   }
 266
 267 # Write out another diff.
 268 if ($spewDiff && @changed_files)
 269   {
 270     print STDERR "  Running cvs diff -u to help you write the ChangeLog entries.\n";
 271     open DIFF, "$CVS -q diff -uN $changed_files_string |" or die "The cvs diff failed: $!.\n";
 272     while (<DIFF>) { print; }
 273     close DIFF;
 274   }
 275
 276 # Open ChangeLogs.
 277 if ($openChangeLogs && $logs)
 278   {
 279     print STDERR "  Opening the edited ChangeLog files.\n";
 280     my $editor = $ENV{"CHANGE_LOG_EDIT_APPLICATION"};
 281     if ($editor) {
 282         system "open -a '$editor'$logs";
 283     } else {
 284         system "open -e$logs";
 285     }
 286   }
 287
 288 # Done.
 289 exit;
 290
 291 sub get_function_line_ranges
 292   {
 293     my ($file_handle, $file_name) = @_;
 294
 295     if ($file_name =~ /\.(c|cpp|m|mm|h)$/) {
 296         return get_function_line_ranges_for_c ($file_handle, $file_name);
 297     } elsif ($file_name =~ /\.java$/) {
 298         return get_function_line_ranges_for_java ($file_handle, $file_name);
 299     }
 300     return ();
 301   }
 302
 303
 304 sub method_decl_to_selector
 305   {
 306     (my $method_decl) = @_;
 307
 308     $_ = $method_decl;
 309
 310     if ((my $comment_stripped) = m-([^/]*)(//|/*).*-)
 311       {
 312         $_ = $comment_stripped;
 313       }
 314
 315     s/,\s*...//;
 316
 317     if (/:/)
 318       {
 319         my @components = split /:/;
 320         pop @components if (scalar @components > 1);
 321         $_ = (join ':', map {s/.*[^[:word:]]//; scalar $_;} @components) . ':';
 322       } else {
 323         s/\s*$//;
 324         s/.*[^[:word:]]//;
 325       }
 326
 327     return $_;
 328   }
 329
 330
 331
 332 # Read a file and get all the line ranges of the things that look like C functions.
 333 # A function name is the last word before an open parenthesis before the outer
 334 # level open brace. A function starts at the first character after the last close
 335 # brace or semicolon before the function name and ends at the close brace.
 336 # Comment handling is simple-minded but will work for all but pathological cases.
 337 #
 338 # Result is a list of triples: [ start_line, end_line, function_name ].
 339
 340 sub get_function_line_ranges_for_c
 341   {
 342     my ($file_handle, $file_name) = @_;
 343
 344     my @ranges;
 345
 346     my $in_comment = 0;
 347     my $in_macro = 0;
 348     my $in_method_declaration = 0;
 349     my $in_parentheses = 0;
 350     my $in_braces = 0;
 351     my $brace_start = 0;
 352     my $brace_end = 0;
 353     my $skip_til_brace_or_semicolon = 0;
 354
 355     my $word = "";
 356     my $interface_name = "";
 357
 358     my $potential_method_char = "";
 359     my $potential_method_spec = "";
 360
 361     my $potential_start = 0;
 362     my $potential_name = "";
 363
 364     my $start = 0;
 365     my $name = "";
 366
 367     my $next_word_could_be_namespace = 0;
 368     my $potential_namespace = "";
 369     my @namespaces;
 370
 371     while (<$file_handle>)
 372       {
 373         # Handle continued multi-line comment.
 374         if ($in_comment)
 375           {
 376             next unless s-.*\*/--;
 377             $in_comment = 0;
 378           }
 379
 380         # Handle continued macro.
 381         if ($in_macro)
 382           {
 383             $in_macro = 0 unless /\\$/;
 384             next;
 385           }
 386
 387         # Handle start of macro (or any preprocessor directive).
 388         if (/^\s*\#/)
 389           {
 390             $in_macro = 1 if /^([^\\]|\\.)*\\$/;
 391             next;
 392           }
 393
 394         # Handle comments and quoted text.
 395         while (m-(/\*|//|\'|\")-) # \' and \" keep emacs perl mode happy
 396           {
 397             my $match = $1;
 398             if ($match eq "/*")
 399               {
 400                 if (!s-/\*.*?\*/--)
 401                   {
 402                     s-/\*.*--;
 403                     $in_comment = 1;
 404                   }
 405               }
 406             elsif ($match eq "//")
 407               {
 408                 s-//.*--;
 409               }
 410             else # ' or "
 411               {
 412                 if (!s-$match([^\\]|\\.)*?$match--)
 413                   {
 414                     warn "mismatched quotes at line $. in $file_name\n";
 415                     s-$match.*--;
 416                   }
 417               }
 418           }
 419
 420
 421         # continued method declaration
 422         if ($in_method_declaration)
 423           {
 424               my $original = $_;
 425               my $method_cont = $_;
 426
 427               chomp $method_cont;
 428               $method_cont =~ s/[;\{].*//;
 429               $potential_method_spec = "${potential_method_spec} ${method_cont}";
 430
 431               $_ = $original;
 432               if (/;/)
 433                 {
 434                   $potential_start = 0;
 435                   $potential_method_spec = "";
 436                   $potential_method_char = "";
 437                   $in_method_declaration = 0;
 438                   s/^[^;\{]*//;
 439                 } elsif (/{/) {
 440                   my $selector = method_decl_to_selector ($potential_method_spec);
 441                   $potential_name = "${potential_method_char}\[${interface_name} ${selector}\]";
 442
 443                   $potential_method_spec = "";
 444                   $potential_method_char = "";
 445                   $in_method_declaration = 0;
 446
 447                   $_ = $original;
 448                   s/^[^;{]*//;
 449                 } else {
 450                   next;
 451                 }
 452           }
 453
 454
 455         # start of method declaration
 456         if ((my $method_char, my $method_spec) = m&^([-+])([^0-9;][^;]*);?$&)
 457           {
 458             my $original = $_;
 459
 460             if ($interface_name)
 461               {
 462                 chomp $method_spec;
 463                 $method_spec =~ s/\{.*//;
 464
 465                 $potential_method_char = $method_char;
 466                 $potential_method_spec = $method_spec;
 467                 $potential_start = $.;
 468                 $in_method_declaration = 1;
 469               } else {
 470                 warn "declaring a method but don't have interface on line $. in $file_name\n";
 471               }
 472             $_ = $original;
 473             if (/\{/) {
 474               my $selector = method_decl_to_selector ($potential_method_spec);
 475               $potential_name = "${potential_method_char}\[${interface_name} ${selector}\]";
 476
 477               $potential_method_spec = "";
 478               $potential_method_char = "";
 479               $in_method_declaration = 0;
 480               $_ = $original;
 481               s/^[^{]*//;
 482             } else {
 483               next;
 484             }
 485           }
 486
 487
 488         # Find function, interface and method names.
 489         while (m&((?:[[:word:]]+::)*operator(?:[ \t]*\(\)|[^()]*)|[[:word:]:~]+|[(){}:;])|\@(?:implementation|interface|protocol)\s+(\w+)[^{]*&g)
 490           {
 491             # interface name
 492             if ($2)
 493               {
 494                 $interface_name = $2;
 495                 next;
 496               }
 497
 498             # Open parenthesis.
 499             if ($1 eq "(")
 500               {
 501                 $potential_name = $word unless $in_parentheses || $skip_til_brace_or_semicolon;
 502                 $in_parentheses++;
 503                 next;
 504               }
 505
 506             # Close parenthesis.
 507             if ($1 eq ")")
 508               {
 509                 $in_parentheses--;
 510                 next;
 511               }
 512
 513             # C++ constructor initializers
 514             if ($1 eq ":")
 515               {
 516                   $skip_til_brace_or_semicolon = 1 unless ($in_parentheses || $in_braces);
 517               }
 518
 519             # Open brace.
 520             if ($1 eq "{")
 521               {
 522                 $skip_til_brace_or_semicolon = 0;
 523
 524                 if ($potential_namespace) {
 525                     push @namespaces, $potential_namespace;
 526                     $potential_namespace = "";
 527                     next;
 528                 }
 529
 530                 # Promote potential name to real function name at the
 531                 # start of the outer level set of braces (function body?).
 532                 if (!$in_braces and $potential_start)
 533                   {
 534                     $start = $potential_start;
 535                     $name = $potential_name;
 536                     if (@namespaces && (length($name) < 2 || substr($name,1,1) ne "[")) {
 537                         $name = join ('::', @namespaces, $name);
 538                     }
 539                   }
 540
 541                 $in_method_declaration = 0;
 542
 543                 $brace_start = $. if (!$in_braces);
 544                 $in_braces++;
 545                 next;
 546               }
 547
 548             # Close brace.
 549             if ($1 eq "}")
 550               {
 551                 if (!$in_braces && @namespaces) {
 552                     pop @namespaces;
 553                     next;
 554                 }
 555
 556                 $in_braces--;
 557                 $brace_end = $. if (!$in_braces);
 558
 559                 # End of an outer level set of braces.
 560                 # This could be a function body.
 561                 if (!$in_braces and $name)
 562                   {
 563                     push @ranges, [ $start, $., $name ];
 564                     $name = "";
 565                   }
 566
 567                 $potential_start = 0;
 568                 $potential_name = "";
 569                 next;
 570               }
 571
 572             # Semicolon.
 573             if ($1 eq ";")
 574               {
 575                 $skip_til_brace_or_semicolon = 0;
 576                 $potential_start = 0;
 577                 $potential_name = "";
 578                 $in_method_declaration = 0;
 579                 next;
 580               }
 581
 582             # Ignore "const" method qualifier.
 583             if ($1 eq "const") {
 584                 next;
 585             }
 586
 587             if ($1 eq "namespace" || $1 eq "class" || $1 eq "struct") {
 588                 $next_word_could_be_namespace = 1;
 589                 next;
 590             }
 591
 592             # Word.
 593             $word = $1;
 594             if (!$skip_til_brace_or_semicolon) {
 595               if ($next_word_could_be_namespace) {
 596                 $potential_namespace = $word;
 597                 $next_word_could_be_namespace = 0;
 598               } elsif ($potential_namespace) {
 599                 $potential_namespace = "";
 600               }
 601
 602               if (!$in_parentheses) {
 603                 $potential_start = 0;
 604                 $potential_name = "";
 605               }
 606               if (!$potential_start) {
 607                 $potential_start = $.;
 608                 $potential_name = "";
 609               }
 610             }
 611           }
 612       }
 613
 614     warn "missing close braces in $file_name (probable start at $brace_start)\n" if ($in_braces > 0);
 615     warn "too many close braces in $file_name (probable start at $brace_end)\n" if ($in_braces < 0);
 616
 617     warn "mismatched parentheses in $file_name\n" if $in_parentheses;
 618
 619     return @ranges;
 620   }
 621
 622
 623
 624 # Read a file and get all the line ranges of the things that look like Java
 625 # classes, interfaces and methods.
 626 #
 627 # A class or interface name is the word that immediately follows
 628 # `class' or `interface' when followed by an open curly brace and not
 629 # a semicolon. It can appear at the top level, or inside another class
 630 # or interface block, but not inside a function block
 631 #
 632 # A class or interface starts at the first character after the first close
 633 # brace or after the function name and ends at the close brace.
 634 #
 635 # A function name is the last word before an open parenthesis before
 636 # an open brace rather than a semicolon. It can appear at top level or
 637 # inside a class or interface block, but not inside a function block.
 638 #
 639 # A function starts at the first character after the first close
 640 # brace or after the function name and ends at the close brace.
 641 #
 642 # Comment handling is simple-minded but will work for all but pathological cases.
 643 #
 644 # Result is a list of triples: [ start_line, end_line, function_name ].
 645
 646 sub get_function_line_ranges_for_java
 647   {
 648     my ($file_handle, $file_name) = @_;
 649
 650     my @current_scopes;
 651
 652     my @ranges;
 653
 654     my $in_comment = 0;
 655     my $in_macro = 0;
 656     my $in_parentheses = 0;
 657     my $in_braces = 0;
 658     my $in_non_block_braces = 0;
 659     my $class_or_interface_just_seen = 0;
 660
 661     my $word = "";
 662
 663     my $potential_start = 0;
 664     my $potential_name = "";
 665     my $potential_name_is_class_or_interface = 0;
 666
 667     my $start = 0;
 668     my $name = "";
 669     my $current_name_is_class_or_interface = 0;
 670
 671     while (<$file_handle>)
 672       {
 673         # Handle continued multi-line comment.
 674         if ($in_comment)
 675           {
 676             next unless s-.*\*/--;
 677             $in_comment = 0;
 678           }
 679
 680         # Handle continued macro.
 681         if ($in_macro)
 682           {
 683             $in_macro = 0 unless /\\$/;
 684             next;
 685           }
 686
 687         # Handle start of macro (or any preprocessor directive).
 688         if (/^\s*\#/)
 689           {
 690             $in_macro = 1 if /^([^\\]|\\.)*\\$/;
 691             next;
 692           }
 693
 694         # Handle comments and quoted text.
 695         while (m-(/\*|//|\'|\")-) # \' and \" keep emacs perl mode happy
 696           {
 697             my $match = $1;
 698             if ($match eq "/*")
 699               {
 700                 if (!s-/\*.*?\*/--)
 701                   {
 702                     s-/\*.*--;
 703                     $in_comment = 1;
 704                   }
 705               }
 706             elsif ($match eq "//")
 707               {
 708                 s-//.*--;
 709               }
 710             else # ' or "
 711               {
 712                 if (!s-$match([^\\]|\\.)*?$match--)
 713                   {
 714                     warn "mismatched quotes at line $. in $file_name\n";
 715                     s-$match.*--;
 716                   }
 717               }
 718           }
 719
 720         # Find function names.
 721         while (m-(\w+|[(){};])-g)
 722           {
 723             # Open parenthesis.
 724             if ($1 eq "(")
 725               {
 726                 if (!$in_parentheses) {
 727                     $potential_name = $word;
 728                     $potential_name_is_class_or_interface = 0;
 729                 }
 730                 $in_parentheses++;
 731                 next;
 732               }
 733
 734             # Close parenthesis.
 735             if ($1 eq ")")
 736               {
 737                 $in_parentheses--;
 738                 next;
 739               }
 740
 741             # Open brace.
 742             if ($1 eq "{")
 743               {
 744                 # Promote potential name to real function name at the
 745                 # start of the outer level set of braces (function/class/interface body?).
 746                 if (!$in_non_block_braces
 747                     and (!$in_braces or $current_name_is_class_or_interface)
 748                     and $potential_start)
 749                   {
 750                     if ($name)
 751                       {
 752                           push @ranges, [ $start, ($. - 1),
 753                                           join ('.', @current_scopes) ];
 754                       }
 755
 756
 757                     $current_name_is_class_or_interface = $potential_name_is_class_or_interface;
 758
 759                     $start = $potential_start;
 760                     $name = $potential_name;
 761
 762                     push (@current_scopes, $name);
 763                   } else {
 764                       $in_non_block_braces++;
 765                   }
 766
 767                 $potential_name = "";
 768                 $potential_start = 0;
 769
 770                 $in_braces++;
 771                 next;
 772               }
 773
 774             # Close brace.
 775             if ($1 eq "}")
 776               {
 777                 $in_braces--;
 778
 779                 # End of an outer level set of braces.
 780                 # This could be a function body.
 781                 if (!$in_non_block_braces)
 782                   {
 783                     if ($name)
 784                       {
 785                         push @ranges, [ $start, $.,
 786                                         join ('.', @current_scopes) ];
 787
 788                         pop (@current_scopes);
 789
 790                         if (@current_scopes)
 791                           {
 792                             $current_name_is_class_or_interface = 1;
 793
 794                             $start = $. + 1;
 795                             $name =  $current_scopes[$#current_scopes-1];
 796                           }
 797                         else
 798                           {
 799                             $current_name_is_class_or_interface = 0;
 800                             $start = 0;
 801                             $name =  "";
 802                           }
 803                     }
 804                   }
 805                 else
 806                   {
 807                     $in_non_block_braces-- if $in_non_block_braces;
 808                   }
 809
 810                 $potential_start = 0;
 811                 $potential_name = "";
 812                 next;
 813               }
 814
 815             # Semicolon.
 816             if ($1 eq ";")
 817               {
 818                 $potential_start = 0;
 819                 $potential_name = "";
 820                 next;
 821               }
 822
 823             if ($1 eq "class" or $1 eq "interface")
 824               {
 825                 $class_or_interface_just_seen = 1;
 826                 next;
 827               }
 828
 829             # Word.
 830             $word = $1;
 831             if (!$in_parentheses)
 832               {
 833                 if ($class_or_interface_just_seen) {
 834                     $potential_name = $word;
 835                     $potential_start = $.;
 836                     $class_or_interface_just_seen = 0;
 837                     $potential_name_is_class_or_interface = 1;
 838                     next;
 839                 }
 840               }
 841             if (!$potential_start)
 842               {
 843                 $potential_start = $.;
 844                 $potential_name = "";
 845               }
 846             $class_or_interface_just_seen = 0;
 847           }
 848       }
 849
 850     warn "mismatched braces in $file_name\n" if $in_braces;
 851     warn "mismatched parentheses in $file_name\n" if $in_parentheses;
 852
 853     return @ranges;
 854   }