toolchain/gcc/libjava/scripts/classes.pl

   1 # classes.pl - A perl program to generate most of the contents of
   2 # javaprims.h automatically.
   3
   4 # Copyright (C) 1998, 1999, 2000, 2002  Red Hat, Inc.
   5 #
   6 # This file is part of libjava.
   7 #
   8 # This software is copyrighted work licensed under the terms of the
   9 # Libjava License.  Please consult the file "LIBJAVA_LICENSE" for
  10 # details.
  11
  12 # Usage: cd <top-srcdir> ; perl classes.pl.
  13 # Can also be run from the `include' directory; this lets us
  14 # more easily insert the output into javaprims.h (which is where it goes).
  15
  16 use DirHandle;
  17
  18 if (-d 'java')
  19 {
  20     # Ok here.
  21 }
  22 elsif (-d '../java')
  23 {
  24     chdir ('..');
  25 }
  26 else
  27 {
  28     die "couldn't find java directory\n";
  29 }
  30
  31 &scan ('java', 2);
  32
  33 exit 0;
  34
  35 sub scan
  36 {
  37     local ($dir, $indent) = @_;
  38     local (@subdirs) = ();
  39     local (%classes) = ();
  40
  41     local ($d) = new DirHandle $dir;
  42     local (*JFILE);
  43     local ($name);
  44     if (defined $d)
  45     {
  46         while (defined ($name = $d->read))
  47         {
  48             next if $name eq 'CVS';
  49             next if $name eq '.';
  50             next if $name eq '..';
  51             if ($dir eq 'java'
  52                 && $name ne 'lang'
  53                 && $name ne 'util'
  54                 && $name ne 'io')
  55             {
  56                 # We only generate decls for java.lang, java.io, and
  57                 # java.util.
  58                 next;
  59             }
  60             if (-d ($dir . '/' . $name))
  61             {
  62                 push (@subdirs, $name);
  63                 next;
  64             }
  65             next unless $name =~ /\.java$/;
  66
  67             open (FILE, "< $dir/$name");
  68             local ($outer, $classname);
  69             while (<FILE>)
  70             {
  71                 s,//.*$,,;
  72                 # NOTE: we don't skip `/*' comments.  However, we do
  73                 # skip lines with a `*' with leading whitespace.  This
  74                 # catches the most important cases.
  75                 s,^\s*\*.*$,,;
  76
  77                 # For now assume that class names start with upper
  78                 # case letter.
  79                 next unless /\b(class|interface) ([A-Z][A-Za-z0-9]+)/;
  80                 $classname = $2;
  81
  82                 # We assume the code is properly indented, so that we
  83                 # can print inner classes properly.
  84                 if (/^\s/)
  85                 {
  86                     die "no outer class for $classname in $dir/$name"
  87                         unless $outer;
  88                     $classes{$outer . "\$" . $classname} = 1;
  89                 }
  90                 else
  91                 {
  92                     $classes{$classname} = 1;
  93                     $outer = $classname;
  94                 }
  95             }
  96             close (FILE);
  97         }
  98
  99         undef $d;
 100     }
 101
 102     local ($spaces) = ' ' x $indent;
 103     local ($classname);
 104     ($classname = $dir) =~ s/^.*\///;
 105     print $spaces, "namespace ", $classname, "\n";
 106     print $spaces, "{\n";
 107
 108     foreach (sort keys %classes)
 109     {
 110         print $spaces, "  class ", $_, ";\n";
 111     }
 112     print "\n" if scalar @classes > 0 && scalar @subdirs > 0;
 113
 114     local ($first) = 1;
 115     foreach (sort @subdirs)
 116     {
 117         print "\n" unless $first;
 118         $first = 0;
 119         &scan ("$dir/$_", $indent + 2);
 120     }
 121
 122     print $spaces, "}\n";
 123 }