#! /usr/local/bin/perl

# file: $isip/util/devel/check_code/isip_check_code.pl
#

# load the command line package
#
require "$ENV{ISIP_IFC}/lib/scripts/perl/command_line.pm";

# split list of files into .cc and other
#
($arg, $ret, $retfull, $debug,
 $method_com, @files) = command_line(-1, "-methods", 0, 
				     "-ret", 0,
				     "-retfull", 0,
				     "-debug", 0,
				     "-comment", 0);

@other_files = grep(!/\.(cc|h)$/, @files);
@files = grep(/\.(cc|h)$/,@files);

# print error message for anything other than .cc files
#
foreach $file (@other_files) {
    print "$file:1: cannot check anything but .cc files\n";
}

# loop through the list of filenames
#
NEXT: foreach $file (@files) {

    # open the file
    #
    open(FP,$file) or isip_die("cannot open file $file: $!");
    
    if ($file =~ /.h$/) {
	$header_file = 1;
    } else {
	$header_file = 0;
    }

    # initialize the state machine
    #
    $state = 0;	
    $_ = `pwd`;
    chop;
    $file_real = "$_\/$file";
    $filename = "";
    $classdir="";
    $method="";
    $multi_method = -1;
    $template_mode = 0;
    $start = 0;
    undef @args;
    $line = 0;
    
    while (<FP>) {
	
	$line ++;
	
	if ($debug) {
	    print "$state: $line: $_";
	}

	# look for the filename comment
	#
	if (($state == 0) &&
	    (/^\/\/ file: \$isip_ifc\/class\/[\w\/]+?\/(\w+)\/(\w+(_\w+\d+\.cc|.h))$/)) {
	    $classdir = $1;
	    $filename = $2;

	    if ($file_real =~ /$classdir\/$filename/) {
		$state = 1;
	    } else {
		print "$file:$line: invalid filename comment\n";
	    }
	    
	    if ($line != 1) {
		print "$file:$line: the filename should be on line 1\n";
	    }
	}
	
	# look for the version comment
	#
	elsif (($state == 1) && (/^\/\/ version: /)) {
	    $state = 1.1;

	    if ($line != 2) {
		print "$file:$line: the version should be on line 2\n";
	    }
	}
	
	elsif (($state == 1.1) && (/^\/\/\s*$/)) {
	    $state = 1.2;

	    if ($line != 3) {
		print "$file:$line: the blank comment should be on line 3\n";
	    }
	}
	elsif (($state == 1.2) && (/^\s*$/)) {
	    
	    if ($header_file == 1) {
		$state = 3;
	    } else {
		$state = 2;
	    }

	    if ($line != 4) {
		print "$file:$line: the blankline should be on line 4\n";
	    }
	}

	# look for isip include files
	#
	elsif (($state == 2) && (/isip include files/)) {
	    $state = 3;
	}
	elsif ((($state == 2) || ($state == 3))
	       && (/there is no source code in this file/)) {
	    $state = 8;
	}
	
	# look for the method name
	#
	elsif ($state == 3) {
	    
	    $header_args = 0;

	    if (/^\s*\/\/ method: ([\w ]+)/) {
		$method = $1;
		$method =~ s/\s*$//;
		
		if ($debug) {
		    print "method found: $method\n";
		}
		if ($header_file == 1) {
		    $state = 6;
		} else {
		    $state = 4;
		}
	    }
	    elsif ((/system include files/) && ($header_file == 0)) {
		print "$file:$line: list system include before isip include\n";
	    }
	}

	# look for the argument list
	#
	elsif (($state == 4) && (/arguments:/)) {
	    $state = 5;
	    $pre_ret_blank = 0;
	    undef @args;
	}
	
	elsif ($state == 5) {

	    $return = "";
	    $comment = "";
	    $pre_blank = 0;
	    $post_blank = 0;
	    
	    # read in the argument list from the comments. 
	    #
	    if (/\/\/\s+((?:const |).*?):(\s+)\((input|output|input\/output)\)(\s*)\S+/) {

		push @args, $1;
		if ($pre_ret_blank == 1) {
		    print "$file:", $line-1, ": blank line found\n";
		    $pre_ret_blank = 0;
		}
		if ($2 ne " ") {
		    print "$file:$line: spacing error between : and (\n";
		}
		if ($4 ne " ") {
		    print "$file:$line: spacing error after )\n";
		}
		
		if (/^\/\/  \w/ == 0) {
		    print "$file:$line: spacing error before arg definition\n";
		}
	    }

	    # blank comment line, only should have one
	    #
	    elsif (/^\/\/\s*$/) {
		if ($pre_ret_blank == 1) {
		    print "$file:$line: too many blank lines\n";
		} else {
		    $pre_ret_blank = 1;
		}
	    }
	    # the argument list ends with the return value statement
	    #
	    elsif (/return: (.*)\s*$/) {
		$return = $1;
		if ($debug) {
		    print ("args = ", join(',', @args), "\n");
		}
		if ($retfull) {
		    print "$file:$line: return value = $return\n";
		}
		$ret_line = $line;
		$func_def = "";
		$state = 6;
	    }
	    elsif (/:/) {
		print "$file:$line: invalid argument definition\n";
	    }
	    else {
		print "$file:$line: ERROR: couldn't parse line\n";
	    }
	}
	elsif ($state == 6) {

	    # see if arguments were defined for the header file (such
	    # as dstr classes
	    #

	    if (($header_file == 1) && (/arguments:/)) {
		$state = 5;
		$header_args = 1;
		$pre_ret_blank = 0;
		undef @args;
	    }

	    # grab the comment until the method is defined
	    #
	    if (/^\s*\/\/(.*)$/) {
		$func_def = "";
		
		$comm_line = $1;
		
		if ($comm_line =~ /^\s*$/) {
		    if ($comment eq "") {
			if ($pre_blank == 0) {
			    $pre_blank = 1;
			}
			elsif ($header_file == 0) {
			    print "$file:$line: too many blank lines 6.1\n";
			}
		    }
		    else {
			if ($post_blank == 0) {
			    $post_blank = 1;
			}
			elsif ($header_file == 0) {
			    print "$file:$line: too many blank lines 6.2\n";
			}
		    }
		}
		else {
		    $post_blank = 0;
		    if (($comment eq "") && ($method_com)) {
			print "$file:$line: method comment\n";
			$comment = $comm_line;
		    }
		    else {
			$comment = join(' ', $comment,$comm_line);
		    }
		}
	    }
	    # look and see if this is a template 
	    #  clears multi-line function definition
	    #
	    elsif (/^template/) {
		$template_mode = 1;
		$multi_method = -1;
		$func_def = "";
	    }

	    # handle multi-line function definitions
	    #
	    else {
		
		chop;
		if ($func_def ne "") {
		    if (/\)\{/) {
			print "$file:$line: spacing error before {\n";
		    }
		    $func_def = join(' ',$func_def, $_);
		    $func_def =~ s/\s+/ /g;
		    $_ = $func_def;
		} else {
		    if (/\)\{/) {
			print "$file:$line: spacing error before {\n";
		    }
		    $func_def = $_;
		    $func_def =~ s/\s+/ /g;
		}
		if ($debug) {
		    print "func_def = >$_<\n";
		}
	    }
	    
	    # this should accept all formats of function definitions
	    #
	    if ((/^[\w\ :\*\&]+ (\w+)::(\w+)\((.*?)\) (?:const \{|\{|\{\}|const \{\})$/) ||
		(/^(\w+)::~*(\w+)\((.*?)\) (?:const \{|\{|\{\}|const \{\})$/) ||
		(/^[\w\*\&]+ (\w+)::(operator .+?)\((.*?)\) (?:const \{|\{|\{\}|const \{\})$/) ||
		(/^(\w+)::(operator .+?)\((.*?)\) (?:const \{|\{|\{\}|const \{\})$/)
		|| (($header_file == 1) &&
		    (/^[\w\ :\*\&]+? ()(\w+)\((.*?)\) (?:const \{|\{|\{\}|const \{\})$/) ||
		    (/^()\s*(\w+)\((.*?)\) (?:const \{|\{|\{\}|const \{\})$/) ||
		    (/^()\s*[\w\*\&]+ (operator ?.+?)\((.*?)\) (?:const \{|\{|\{\}|const \{\})$/) ||
		    (/^()\s*(operator ?.+?)\((.*?)\) (?:const \{|\{|\{\}|const \{\})$/))
		|| (($template_mode == 1) &&
		    ((/^[\w\ \>\<:\*\&]+ (\w+)<[\w\ \,]+>::(\w+)\((.*?)\) (?:const \{|\{|\{\}|const \{\})$/) ||
		     (/^(\w+)<[\w\ \,]+>::~*(\w+)\((.*?)\) (?:const \{|\{|\{\}|const \{\})$/) ||
		     (/^[\w\*\&]+ (\w+)<[\w\ \,]+>::(operator .+?)\((.*?)\) (?:const \{|\{|\{\}|const \{\})$/) ||
		     (/^(\w+)<[\w\ \,]+>::(operator .+?)\((.*?)\) (?:const \{|\{|\{\}|const \{\})$/)))) {

		
		if ($debug) {
		    print "$state: $line: found target >$_<\n";
		}
		
		if ($header_file == 1) {
		    $def_method = $2;
		    $arg_defs = $3;
#		    print "arg_defs: 1=>$1<, 2=>$2<, 3=>$3<\n";
		    while ($arg_defs =~ s/(\<[^\>\,]*?),([^\>]*?\>)/$1__ISIP_COMMA_HOLDER__$2/) { }
		    
		    @def_args = grep(s/^\s*(.*?)\s*$/$1/, 
				     split(/,/,$arg_defs));
		    foreach $arg (@def_args) {
			$arg =~ s/__ISIP_COMMA_HOLDER__/,/g;
			if (($#args == -1) 
			     && (($arg =~ /_a$/) || ($arg =~ /_a\s*\=/))) {
			    
			    print "$file:$line: argument \"$arg\" should not have a _a suffix\n";
			}
		    }
		} else {
		    $def_class = $1;
		    $def_method = $2;
		    $arg_defs = $3;
		    while ($arg_defs =~ s/(\<[^\>\,]*?),([^\>]*?\>)/$1__ISIP_COMMA_HOLDER__$2/) { }

		    @def_args = grep(s/^\s*(.*?)\s*$/$1/, 
				     split(/,/,$arg_defs));
		    foreach $arg (@def_args) {
			$arg =~ s/__ISIP_COMMA_HOLDER__/,/g;
		    }
		}

		if (($ret) && ($header_file == 0)) {
		    if (/^(\w+)::~*(\w+)\((.*?)\) \{$/) {
			if ($return =~ !/none/) {
			    print "$file:$ret_line: invalid return comment\n";
			}
		    }
		    elsif ((/^([\w\ \*\&]+) (\w+)::(\w+)\((.*?)\) \{$/) ||
			   (/^([\w\*\&]+) (\w+)::(operator .+?)\((.*?)\) \{$/)) {
			$return_type = $1;
			if (($return_type =~ /boolean/) && 
			    (($return =~ /logical error status/) ||
			     ($return =~ /boolean .*value/) ||
			     ($return =~ /boolean .*result/))) {
			} 
			elsif (($return_type =~ /long/) && 
			       (($return =~ /long index.*/) ||
				($return =~ /long .*value/) ||
				($return =~ /long .*result/))) {
			}
			elsif (($return_type =~ /double/) && 
			       (($return =~ /double .*value/) ||
				($return =~ /double .*result/))) {
			}
			elsif (($return_type =~ /SysString\&/) && 
			       ($return =~ /a static SysString\& containing the class name.*/)) {
			}
			else {
			    print "$file:$ret_line: questionable return comment\n";
			}
		    }
		    else {
			print "$file:$ret_line: invalid return comment\n";
		    }
		}

		# make sure the classname matches the class directory
		#
		if ((($def_class =~ /$classdir/i) == 0) && ($header_file == 0)) {
		    #print "$def_class, $classdir\n";
		    print "$file:$line: invalid class directory comment ($classdir != $def_class)\n";
		}
		
		# make sure the method name matches the comment
		#
		if (($def_method =~ /$method/) == 0) {
		    if ((($method =~ /structor/) == 0) &&
			(($method =~ /operator\(\)/))) {
			print "$def_method, $method\n";
			print "$file:$line: invalid method comment ($method != $def_method)\n";
		    }
		}

		if ($debug) {
		    print "def = ", join(',',@def_args), "\n";
		    print "args = ", join(',',@args), "\n";
		}

		# make sure the argument lists match
		#
		if ($header_file == 1) {
		    $state = 7;
		    break;
		}

		elsif ($#def_args != $#args) {
#		    print "def = ", join(';',@def_args), "\n";
#		    print "args = ", join(';',@args), "\n";
		    $all_def = join(';',@def_args);
		    if ($all_def =~ /\(.*\*.*\)/) {
			print "$file:$line: different number of arguments to method $method (might be function pointers)\n";
		    }
		    else {
			if ($debug) {
			    print "\ndef = ", join(';',@def_args), "\n";
			    print "args = ", join(';',@args), "\n";
			}
			print "$file:$line: different number of arguments to method $method\n";
		    }
		} 
		else {
		    if ($#args >= 0) {
			$i = 0;
			$n = $#args;
			for ($i = 0; $i <= $n; $i++) {
			    $arg = join("_",shift(@args),"a");
			    $def_arg = shift(@def_args);
			    if ($arg ne $def_arg) {
				print "$arg, $def_arg\n";
				print "$file:$line: argument list doesn't match ($arg != $def_arg in method $method)\n";
			    }
			}
		    }
		}
		if ($multi_method > 0) {
		    $multi_method =0;
		}
		$state = 7;
	    }
	}

	# look for either a new method comment (for multiple
	# methods/file), or for error calls, or for spacing, or for
	# logical overdeclaration.
	#
	elsif ($state == 7) {
	    
	    # we only allow multiple methods to be in the same file if
	    # the first are trivial variations (overloads) of the
	    # second, so we start a new state machine looking for
	    # tell-tale signs.
	    #
	    if (($multi_method == 0) && (/call the master function/)) {
		$multi_method = 1;
	    } elsif (($multi_method == 1) && (/return $method\(/)) {
		$multi_method = 2;
	    }
	    
	    if ((($method =~ /^diagnose/) == 0) && 
		(/Error\:\:handle\(name\(\), L\"(\w+)\"/) && ($1 ne $method)) {
		print "$file:$line: sending invalid methodname $1 to Error in method $method\n";
	    }
	    elsif ((($method =~ /^diagnose/) == 0) && 
		   (/Error\:\:handle\(name\(\), L\"\w+\", Error::TEST/)) {
		print "$file:$line: Error::TEST should ONLY be used in diagnose methods\n";
	    }
	    elsif (/^\s*\/\/ method: ([\w ]+)/) {
		if ($multi_method >= 0) {
		    if ($multi_method != 2) {
			print "$file:$line: inclusion of a second method in a file which starts with a non-trivial method\n";
		    }
		    if ($method ne $1) {
			print "$file:$line: inclusion of a second dissimilar method in one file\n";
		    }
		    $multi_method = 0;
		}
		$method = $1;
		$method =~ s/\s*$//;
		if ($header_file == 1) {
		    $state = 6;
		} else {
		    $state = 4;
		}
	    }
	    
	    # make sure we aren't too explicit with Integral::TRUE and FALSE
	    #
	    if (/[!=]=\s*(true|false)/) {
		print "$file:$line: you are too explicit with boolean's\n";
	    }

	    if (/(>|>=|<|<=|-|\+)\s*(true|false)/) {
		print "$file:$line: you can't do this with a boolean\n";
	    }
	    
	    # possibly check spacing of operators
	    #
	    if (length($_) < 72) {
		
		# nix comments
		#
		if (/\/\//) {
 		    s/^(.*?)\/\/.*$/$1/;
		}
		
		# nix strings and literals
		#
		if (/[^\\]\".*[^\\]\"/) {
		    while (s/^(.*?[^\\])\".*?[^\\]\"(.*)$/$1$2/) {}
		}
		
		# parse away template operands, too messy
		#
		if (/<.*?>/) {
		    
		    if ((/<.*?<[a-zA-Z_]+> >/) && 
			((/< .*?<[a-zA-Z_]+> >/) == 0)) {
			print "$file:$line: nested-template spacing error\n";
		    }
		    s/<[a-zA-Z_]+>//;
		}
		
		if (/[^\\]\'.*[^\\]\'/) {
		    while (s/^(.*?[^\\])\'.*?[^\\]\'(.*)$/$1$2/) {}
		}
		elsif (/const_cast/) {
		    
		    # do nothing for now
		    #
		}
		# test assignment spacing
		#
		elsif (((/\b(.*?[^ \!\=\+\-\*\/\%\^\&\|\>\<]=.*?)\b/) &&
			(("$1" =~ /\=\=/) == 0)) ||
		       ((/\b(.*?[^\!\=\+\-\*\/\%\^\&\|]=[^ ].*?)\b/) && 
			(("$1" =~ /\=\=/) == 0))) {
		    print "$file:$line: spacing error about =\n";
		}
		
		# test logical spacing
		#
		elsif ((/[^ \t]==/) || (/==[^ ]/)) {
		    print "$file:$line: spacing error about ==\n";
		}
		elsif ((/[^ \t]!=/) || (/!=[^ ]/)) {
		    print "$file:$line: spacing error about !=\n";
		}
		elsif ((/[^ >]>=/) || (/>=[^ ]/)) {
		    print "$file:$line: spacing error about >=\n";
		}
		elsif ((/[^ <]<=/) || (/<=[^ ]/)) {
		    print "$file:$line: spacing error about <=\n";
		}
		elsif ((/[^ ]>>=/) || (/>>=[^ ]/)) {
		    print "$file:$line: spacing error about >>=\n";
		}
		elsif ((/[^ ]<<=/) || (/<<=[^ ]/)) {
		    print "$file:$line: spacing error about <<=\n";
		}
		elsif (((/[^ ->]>/) || (/[^\-]>[^ >\=]/)) 
		       && (/<[\w\ \,]+>/ == 0)) {
		    print "$file:$line: spacing error about >\n";
		    print;
		}
		elsif (((/[^ <]</) || (/<[^ \=<]/))
		       && (/<[\w\ \,]+>/ == 0)
		       && ((/template<>/) == 0)) {
		    print "$file:$line: spacing error about <\n";
		}
		
		# test arithmetic spacing. + and - are the worst, since we
		# have to allow ++ and --
		#
		elsif (((/\b(.*?[^ \+]\+.*?)\b/) &&
			(("$1" =~ /\+\+/) == 0) &&
			(("$1" =~ /[eE]\+/) == 0)) ||
		       ((/\b(.*?[^\+]\+[^ \=].*?)\b/) && 
			(("$1" =~ /\+\+/) == 0) &&
			(("$1" =~ /[eE]\+/) == 0))) {
		    print "$file:$line: spacing error about +\n";
		}
		elsif ((/\b(.*?[^ \-\(\)]\-.*?)\b/) &&
		       (("$1" =~ /\-[\-\>]/) == 0) &&
		       (("$1" =~ /[eE]\-/) == 0)) {
		    print "$file:$line: spacing error about -\n";
		}
		
		# * is nearly impossible because of pointers, skip it...
		#
		
		# of course / is part of comment //
		#
		elsif ((/[^ ]\//) || (/\/[^ \=]/)) {
		    print "$file:$line: spacing error about /\n";
		}
		
		# I take some liberty here since you never divide on
		# the same line as there is a string.
		#
		elsif (((/[^ ]\\/) || (/\\[^ \=]/)) &&
		       ((/\".*\"/) == 0) && ((/\'.*\'/) == 0)) {
		    print "$file:$line: spacing error about \\\n";
		}
		
		# test accumulative arithmetic operators
		#
		elsif ((/[^ ]\+\=/) || (/\+\=[^ ]/)) {
		    print "$file:$line: spacing error about +=\n";
		}
		elsif ((/[^ ]\-\=/) || (/\-\=[^ ]/)) {
		    print "$file:$line: spacing error about -=\n";
		}
		elsif ((/[^ ]\*=/) || (/\*\=[^ ]/)) {
		    print "$file:$line: spacing error about *=\n";
		}
		elsif ((/[^ ]\\\=/) || (/\\\=[^ ]/)) {
		    print "$file:$line: spacing error about \\=\n";
		}
		elsif ((/[^ ]\/\=/) || (/\/\=[^ ]/)) {
		    print "$file:$line: spacing error about /=\n";
		}
		
		# test accumulative bitwise operators
		#
		elsif ((/[^ ]\^=/) || (/\^\=[^ ]/)) {
		    print "$file:$line: spacing error about \^=\n";
		}
		elsif ((/[^ ]&=/) || (/&\=[^ ]/)) {
		    print "$file:$line: spacing error about &=\n";
		}
		elsif ((/[^ ]\|=/) || (/\|\=[^ ]/)) {
		    print "$file:$line: spacing error about |=\n";
		}
		
		# test commas and semicolons
		#
		elsif (/\,[^ \n]/) {
		    print "$file:$line: spacing error about ,\n";
		}
		elsif (/\;[^ \n\t]/) {
		    print "$file:$line: spacing error about ;\n";
		}
		
		# test increment and decrement (both pre and post)
		#
		elsif ((/\ \+\+[\]\;\)]/) || (/\ \+\+\ /)) {
		    print "$file:$line: spacing error about ++\n";
		}
		elsif ((/\ \-\-[\]\;\)]/) || (/\ \-\-\ /)) {
		    print "$file:$line: spacing error about --\n";
		}

		# test a few reserve words
		#
		elsif (/if\(/) {
		    print "$file:$line: spacing error about if\n";
		}
		elsif (/for\(/) {
		    print "$file:$line: spacing error about for\n";
		}
		elsif (/while\(/) {
		    print "$file:$line: spacing error about while\n";
		}

		# else statements always start the line
		#
		elsif ((/else/) && ((/^\s*else/) == 0) && ((/^\s*#else/)==0)) {
		    print "$file:$line: spacing error about else\n";
		}
		
		# bracket-end should be the ONLY thing on the line, unless
  	        # it is part of a do while loop or has a semicolon after it.
		#
		elsif ((/\}/) && ((/^\s*\}\s*$/) == 0) 
		       && ((/^\s*\} while/) == 0)
		       && ((/\};\s*$/) == 0)
		       && ((/\{\}\s*$/) == 0)) {
							   
		    print "$file:$line: } should be on it's own line\n";
		}
		
		# bracket-start should be last on line, space preceding
		#
		elsif (/[^ ]\{/) {
		    print "$file:$line: spacing error about {\n";
		}
		elsif ((/\{/) && 
		       (((/\{\s*$/) == 0) &&
			((/\{\}\s*$/) == 0) &&
			((/enum.*\{/) == 0))) {
		    print "$file:$line: { should be end of line\n";
		}

		
	    }
	}
    }

    # if we didn't end in a final state (7), inform the user
    #
    if ($state == 6) {
	print "$file:$line: ($state) function '$method' never defined\n";
    }
    elsif ($state == 5) {
	print "$file:$line: ($state) return value never commented\n";
    }
    elsif ($state == 4) {
	print "$file:$line: ($state) arguments never commented\n";
    }
    elsif ($state == 3) {
	if ($header_file == 0) {
	    print "$file:$line: ($state) methodname never commented\n";
	}
    }
    elsif ($state == 2) {
	print "$file:4: ($state) no \"isip include files\" listed\n";
    }
    elsif ($state == 1) {
	print "$file:2: ($state) version never commented\n";
    }
    elsif ($state == 0) {
	print "$file:1: ($state) filename never commented\n";
    }
}

#
# end of file
