#!/usr/bin/perl -w
#
# Check that a set of .h files and .o and .a files satisfy the Pan-STARRS
# rules about namespaces.
#
# This is a real hack; it should be rewritten to parse the .h files correctly. XXX
#
# Robert Lupton (rhl@astro.princeton.edu)  February 2004
#
# Parse arguments
#
$nm_opts = "";
$prefix = "ps";
$pprefix = "p_$prefix";
$verbose = 0;

if (!@ARGV) {
   warn "Please specify some files to check! E.g. *.h *.o\n";
   push @ARGV, "-h";
}

while ($ARGV[0] =~ /^-/) {
   if ($ARGV[0] eq "-h" || $ARGV[0] eq "-?") {
      warn "\
Usage: check-namespace [options] files.h files.o

Check that a set of .h and .o (and/or .a) files obey the pan-STARRS
naming convention, namely that iff a symbol is externally visible, it
should have a name starting \"ps\" or \"p_ps\", and be declared in a
.h file.

E.g. check-namespace *.o *.h

The treatment of comments and typedefs is sleazy and non-robust.

Options:
	-h, -?		Print this message
	-d		Don't warn about symbols defined in .h files but not found by nm
	-p prefix	Change prefix from ps to \"prefix\"
	-v		Be chatty (repeat for even more output)
";
      exit(0);
   } elsif($ARGV[0] eq "-p") {
      shift(@ARGV);
      $arg = $ARGV[0];
      if(!$arg) {
	 warn "-p expects an argument\n";
      } else {
	 $prefix = "$arg";
	 $pprefix = "p_$prefix";
      }
   } elsif($ARGV[0] eq "-d") {
      $allow_missing_definitions = 1;      
   } elsif($ARGV[0] eq "-v") {
      $verbose++;
   } else {
      warn "Unknown argument $ARGV[0]\n";
   }

   shift(@ARGV);
}
#
$uprefix = uc($prefix);
$upprefix = uc($pprefix);
#
# Get list of files to process
#
foreach (@ARGV) {
   if(/\.h$/) {
      push(@hfiles, $_);
   } elsif(/\.[ao]$/) {
      push(@ofiles, $_);
   } else {
      warn "I don't know what to do with $_; ignoring\n";
   }
}
#
# Read all the .h files looking for suitable symbols
#
foreach $file (@hfiles) {
   $in_comment = 0;		# in a multiline comment?
   $in_typedef = 0;		# parsing a typedef?
   
   if ($verbose > 1) {
      warn "   $file\n";
   }

   open(FD, $file) or die "Failed to open $file:$! \n";
   while (<FD>) {
      chomp;
      # Deal with comments, at least approximately
      if($in_comment) {
	 while (!m|\*/|) {
	    $_ = <FD>;
	 }
	 $in_comment = 0;
      }

      s|//.*||;
      if(m|(.*)/\*(.*)|) {
	 $first = $1; $rest = $2;
	 if ($rest =~ m|\*/(.*)|) {
	    $_ = "$first /**/ $1";
	 } else {
	    $_ = $first;
	    $in_comment = 1;
	 }
      }
      #
      # OK, how about typedefs?
      #
      if (/typedef.*\W\(\*(($pprefix|$prefix)[a-zA-Z_0-9]+)\)/o) {
	 $name = $1;
 
	 $typedefs{$name} = $file;
	 $in_typedef--;
      } elsif (/typedef\s+struct/) {
	 if(/([a-zA-Z_0-9]+)\s*;/) {
	    $name = $1;
	    $typedefs{$name} = $file;
	    next;
	 }
	 $in_typedef = 1;
      } elsif ($in_typedef) {
	 if (/\{/) {
	    $in_typedef++;
	 } elsif ($in_typedef > 1 && /\}/) {
	    $in_typedef--;
	 }
      }

      if ($in_typedef) {
	 if (/\}\s*(($prefix|$pprefix)[a-zA-Z_0-9]+)\s*;/) {
	    $in_typedef--;
	    if ($in_typedef == 0) {
	       $name = $1;
	       $typedefs{$name} = $file;
	    }
	 }
      }
      #
      # And #defines?
      #
      if (/^\s*\#\s*define\s+([a-zA-Z_0-9]+)(\()?/) {
	 $name = $1;
	 $func_macro = (defined($2)) ? 1 : 0;

	 $defines{$name} = $file;

	 if((!$func_macro && $name !~ /^($uprefix|$upprefix)/o) ||
	    ($func_macro && $name !~ /^($prefix|$pprefix)/io)) {
	    printf STDERR
		"\#define %s (%s) does not have a permitted prefix\n",
		$name, $file;
	 }
      }
      #
      # OK, how about enums? Their members look like external names,
      # and should obey the same rules
      #
      if (s/((typedef\s+)?enum)(\s*{)/$3/) {
	 $typedef = $1;
	 $is_enum_typedef = ($typedef =~ /typedef/) ? 1 : 0;

	 while (!/\}/) {
	    $line = <FD>;
	    chomp;
	    s|//.*||;
	    s|/\*[^\*]*\*/||;

	    $_ .= " $line";
	 }

	 if ($is_enum_typedef) {
	    if ($line =~ /\}\s*([a-zA-Z_0-9]+)/) {
	       $name = $1;
	       $typedefs{$name} = $file;
	    }
	 }

	 s/^\s*\{\s*//;
	 while (s/([a-zA-Z_0-9]+)(\s*=\s*-?[a-zA-Z_0-9]+)?(\s*,\s*)?\s*//) {
	    if(/^\}/) {
	       last;
	    }
	    
	    $name = $1;

	    if ($name eq "enum") {
	       next;
	    }

	    #$enums{$1} = $file;
	    
	    if($name !~ /^($uprefix|$upprefix)/o) {
	       printf STDERR
		   "enum element %s (%s) does not have a permitted prefix\n",
		   $name, $file;
	    }
	 }
      }
      #
      # Include filenames can look like external names too
      #
      if (/^\s*\#\s*include\s/) {
	 next;
      }
      # Look for possible external symbols
      #
      while(s/(^|\W)(($pprefix|$prefix)[a-zA-Z_0-9]+)//o) {
	 $name = $2;

	 $declarations{$name} = $file;
      }
   }
   close(FD);
}

if($verbose) {
   warn "Typedefs found in header files:\n";
   foreach (sort keys %typedefs) {
      printf STDERR "%-30s %s\n", $_, $typedefs{$_};
   }

   warn "External symbols found in header files:\n";
   foreach (sort keys %declarations) {
      printf STDERR "%-30s %s\n", $_, $declarations{$_};
   }
}
#
# OK, now run nm on the .o and .a files and see if there are problems
# 
foreach $file (@ofiles) {
   if ($verbose) {
      warn "   $file\n";
   }

   open(FD, "nm $nm_opts $file|") or die "Failed to open $file:$! \n";
   while (<FD>) {
      if (/^\s*$/) {
	 next;
      }

      if (/^(lib[A-Za-z0-9]+\.a\(\w+\.o\))/) {
	 $file = $1;
	 next;
      }
      
      if (/^\s+U /) {
	 next;			# an undefined symbol
      }

      my($addr, $type, $name) = split;

      if (!defined($name)) {
	 next;
      }
      $name =~ s/^_//;

      if ($name eq "main") {
	 next;
      }
      if ($name =~ /\./) {
	 next;			# an internal name to the compiler
      }

      if ($type eq "b") { $type = "d"; } # don't distinguish BSS, Common, and Data
      if ($type eq "B") { $type = "D"; }
      if ($type eq "C") { $type = "D"; }

      if ($type !~ /[DT]/i) {	# Data or Text section
	 die "Unknown symbol type in $file: $_\n";
      }

      if ($verbose > 1) {
	 printf "%-20s %-40s %s\n", $file, $name, $type;
      }

      if ($type =~ /[dt]/) {
	 if($name =~ /^($prefix|$pprefix)/o) {
	    warn "Non-global symbol $name in $file is in reserved namespace ($prefix|$pprefix)\n";
	 }
      } elsif ($type =~ /[DT]/) {
	 if ($declarations{$name}) {
	    $used_declarations{$name}++;
	 } elsif ($name !~ /^($pprefix|$prefix)/) {
	    if($name !~ /^($prefix|$pprefix)/io) {
	       printf STDERR
		   "global symbol %s (%s) does not have a permitted prefix\n",
		   $name, $file;
	    }
	 } else {
	    printf STDERR "External symbol %s (%s) appears in no .h file\n",
	    $name, $file;
	 }
      }
   }
   close(FD);
}
#
# Now check for unused declarations
#
if (!$allow_missing_definitions) {
   foreach $name (sort keys %declarations) {
      if (!$used_declarations{$name} && !$typedefs{$name} && !$defines{$name}) {
	 warn "$name was declared in $declarations{$name} but not defined\n";
      }
   }
}
