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