* 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

diff --git a/src/util/ChangeLog b/src/util/ChangeLog
index 46868d38ef31b077f923c913b948720df75dbfa0..0a0f98df7f2bb1efe97af54315feb969b340faf6 100644 (file)
--- 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 (file)
index 0000000..f4d195b
--- /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);