From bd65e8bba8654e2d5e65051388bdf4b22ad04ddd Mon Sep 17 00:00:00 2001
From: Ken Raeburn <raeburn@mit.edu>
Date: Wed, 17 Oct 2001 16:32:25 +0000
Subject: [PATCH] * def-check.pl: New file.  Not currently used by any
 automatic processes.  Checks krb5.hin against krb5_32.def for consistency;
 might work with other .h/.def files but hasn't been tested.

git-svn-id: svn://anonsvn.mit.edu/krb5/trunk@13814 dc483132-0cff-0310-8789-dd5450dbe970
---
 src/util/ChangeLog    |   8 +-
 src/util/def-check.pl | 180 ++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 187 insertions(+), 1 deletion(-)
 create mode 100644 src/util/def-check.pl

diff --git a/src/util/ChangeLog b/src/util/ChangeLog
index 46868d38e..0a0f98df7 100644
--- a/src/util/ChangeLog
+++ b/src/util/ChangeLog
@@ -1,3 +1,9 @@
+2001-10-17  Ken Raeburn  <raeburn@mit.edu>
+
+	* def-check.pl: New file.  Not currently used by any automatic
+	processes.  Checks krb5.hin against krb5_32.def for consistency;
+	might work with other .h/.def files but hasn't been tested.
+
 2001-10-10  Ken Raeburn  <raeburn@mit.edu>
 
 	* depfix.sed: Change "foo.o" to "$(OUTPRE)foo.$(OBJEXT)" so that
@@ -6,7 +12,7 @@
 2001-09-06  Ken Raeburn  <raeburn@mit.edu>
 
 	* depgen.sed: New file.
-	* depfix.sed: Remove /foo/../ sequences, looping til no more.
+	* depfix.sed: Remove /foo/../ sequences, looping 'til no more.
 
 2001-09-01  Ken Raeburn  <raeburn@mit.edu>
 
diff --git a/src/util/def-check.pl b/src/util/def-check.pl
new file mode 100644
index 000000000..f4d195b35
--- /dev/null
+++ b/src/util/def-check.pl
@@ -0,0 +1,180 @@
+#!/usr/athena/bin/perl
+eval 'exec /usr/athena/bin/perl -S $0 ${1+"$@"}'
+	if $running_under_some_shell;
+
+@convC = ();
+@convK = ();
+@convD = ();
+
+open H, "<$ARGV[0]" || die "aaaa! $!";
+open D, "<$ARGV[1]";
+
+LINE:
+while (! eof H) {
+    $_ = <H>;
+    chop;
+    # get calling convention info for function decls
+    # what about function pointer typedefs?
+    # need to verify unhandled syntax actually triggers a report, not ignored
+    # blank lines
+    if (/^[ \t]*$/) {
+        next LINE;
+    }
+  Top:
+    # drop preprocessor directives
+    if (/^ *#/) {
+        next LINE;
+    }
+    if (/^ *\?==/) {
+        next LINE;
+    }
+    s/#.*$//;
+    if (/^} *$/) {
+        next LINE;
+    }
+    # strip comments
+  Cloop1:
+    if (/\/\*./) {
+	s;/\*[^*]*;/*;;
+	s;/\*\*([^/]);/*$1;;
+	s;/\*\*$;/*;;
+	s;/\*\*/; ;g;
+	goto Cloop1;
+    }
+    # multi-line comments?
+    if (/\/\*$/) {
+	$_ .= "\n";
+	$len1 = length;
+	$_ .= <H>;
+	chop if $len1 < length;
+	goto Cloop1 if /\/\*./;
+    }
+    # blank lines
+    if (/^[ \t]*$/) {
+        next LINE;
+    }
+    if (/ *extern "C" {/) {
+        next LINE;
+    }
+    # elide struct definitions
+  Struct1:
+    if (/{[^}]*}/) {
+	s/{[^}]*}/ /g;
+	goto Struct1;
+    }
+    # multi-line defs
+    if (/{/) {
+	$_ .= "\n";
+	$len1 = length;
+	$_ .= <H>;
+	chop if $len1 < length;
+	goto Struct1;
+    }
+  Semi:
+    unless (/;/) {
+	$_ .= "\n";
+	$len1 = length;
+	$_ .= <H>;
+	chop if $len1 < length;
+	s/\n/ /g;
+	s/[ \t]+/ /g;
+	s/^[ \t]*//;
+	goto Top;
+    }
+    if (/^typedef[^;]*;/) {
+	s/^typedef[^;]*;//g;
+	goto Semi;
+    }
+    if (/^struct[^\(\)]*;/) {
+	s/^struct[^\(\)]*;//g;
+	goto Semi;
+    }
+    # should just have simple decls now; split lines at semicolons
+    s/ *;[ \t]*$//;
+    s/ *;/\n/g;
+    if (/^[ \t]*$/) {
+        next LINE;
+    }
+    s/[ \t]*$//;
+    goto Notfunct unless /\(.*\)/;
+    # here, is probably function decl
+    # strip simple arg list - parens, no parens inside; discard, iterate.
+    # the iteration should deal with function pointer args.
+  Striparg:
+    if (/ *\([^\(\)]*\)/) {
+	s/ *\([^\(\)]*\)//g;
+	goto Striparg;
+    }
+    # replace return type etc with one token indicating calling convention
+    if (/CALLCONV/) {
+	if (/KRB5_CALLCONV_C/) {
+	    s/^.*KRB5_CALLCONV_C *//;
+	    push @convC, $_;
+	} elsif (/KRB5_CALLCONV/) {
+	    s/^.*KRB5_CALLCONV *//;
+	    push @convK, $_;
+	} else {
+	    die horribly;
+	}
+	goto Hadcallc;
+    }
+    # deal with no CALLCONV indicator
+    s/^.* (\w+) *$/$1/;
+    push @convD, $_;
+  Hadcallc:
+    goto Skipnotf;
+  Notfunct:
+    # probably a variable
+    s/^/VARIABLE_DECL /;
+  Skipnotf:
+    # toss blank lines
+    if (/^[ \t]*$/) {
+        next LINE;
+    }
+}
+
+print join("\n\t", "Using default calling convention:", sort(@convD));
+print join("\n\t", "\nUsing KRB5_CALLCONV:", sort(@convK));
+print join("\n\t", "\nUsing KRB5_C_CALLCONV:", sort(@convC));
+print "\n";
+
+%conv = ();
+map { $conv{$_} = "default"; } @convD;
+map { $conv{$_} = "KRB5"; } @convK;
+map { $conv{$_} = "KRB5_C"; } @convC;
+
+LINE2:
+while (! eof D) {
+    $_ = <D>;
+    chop;
+    #
+    if (/^;/) {
+        $printit = 0;
+        next LINE2;
+    }
+    if (/^[ \t]*$/) {
+        $printit = 0;
+        next LINE2;
+    }
+    if (/^EXPORTS/) {
+        $printit = 0;
+        next LINE2;
+    }
+    s/[ \t]*//g;
+    my($xconv);
+    if (/!CALLCONV/) {
+	$xconv = "KRB5_C";
+    } else {
+	$xconv = "KRB5";
+    }
+    s/;.*$//;
+    if (!defined($conv{$_})) {
+	print "No calling convention specified for $_!\n";
+    } elsif ($conv{$_} != $xconv) {
+	print "Function $_ should have calling convention '$xconv', but has '$conv{$_}' instead.\n";
+    } else {
+#	print "Function $_ is okay.\n";
+    }
+}
+
+#print "Calling conventions defined for: ", keys(%conv);
-- 
2.26.2