diff options
Diffstat (limited to 'src/util')
| -rw-r--r-- | src/util/ChangeLog | 8 | ||||
| -rw-r--r-- | src/util/def-check.pl | 180 |
2 files changed, 187 insertions, 1 deletions
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); |