diff options
author | surles <surles> | 1999-04-14 00:26:38 (GMT) |
---|---|---|
committer | surles <surles> | 1999-04-14 00:26:38 (GMT) |
commit | 17c0f55720d2ea626d018f10484339d454f336b1 (patch) | |
tree | 05468c78d63639917458ce8469272a0a96986868 /tools | |
parent | 82fe238eb87c438f9a8f9c44904816ebb35a8523 (diff) | |
download | tcl-17c0f55720d2ea626d018f10484339d454f336b1.zip tcl-17c0f55720d2ea626d018f10484339d454f336b1.tar.gz tcl-17c0f55720d2ea626d018f10484339d454f336b1.tar.bz2 |
initial checkin of doc checker script
Diffstat (limited to 'tools')
-rwxr-xr-x | tools/checkLibraryDoc.tcl | 242 |
1 files changed, 242 insertions, 0 deletions
diff --git a/tools/checkLibraryDoc.tcl b/tools/checkLibraryDoc.tcl new file mode 100755 index 0000000..da9aa2f --- /dev/null +++ b/tools/checkLibraryDoc.tcl @@ -0,0 +1,242 @@ +# checkLibraryDoc.tcl -- +# +# This script attempts to determine what APIs exist in the source base that +# have not been documented. By grepping through all of the doc/*.3 man +# pages, looking for "Pkg_*" (e.g., Tcl_ or Tk_), and comparing this list +# against the list of Pkg_ APIs found in the source (e.g., tcl8.1/*/*.[ch]) +# we create six lists: +# 1) APIs in Source not in Docs. +# 2) APIs in Docs not in Source. +# 3) Internal APIs and structs. +# 4) Misc APIs and structs that we are not documenting. +# 5) Command APIs (e.g., Tcl_ArrayObjCmd.) +# 6) Proc pointers (e.g., Tcl_CloseProc.) +# +# Note: Each list is "a best guess" approximation. If developers write +# non-standard code, this script will produce erroneous results. Each +# list should be carefully checked for accuracy. +# +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. +# +# RCS: @(#) $Id: checkLibraryDoc.tcl,v 1.1.2.1 1999/04/14 00:26:38 surles Exp $ + + +#lappend auto_path "c:/program\ files/tclpro1.2/win32-ix86/bin" +if {[catch {package require Tclx}]} { + puts "error: could not load TclX. Please set TCL_LIBRARY." + exit 1 +} + +# A list of structs that are known to be undocumented. + +set StructList { + Tcl_AsyncHandler \ + Tcl_CallFrame \ + Tcl_Condition \ + Tcl_Encoding \ + Tcl_EncodingState \ + Tcl_EncodingType \ + Tcl_EolTranslation \ + Tcl_HashEntry \ + Tcl_HashSearch \ + Tcl_HashTable \ + Tcl_Mutex \ + Tcl_Pid \ + Tcl_QueuePosition \ + Tcl_ResolvedVarInfo \ + Tcl_SavedResult \ + Tcl_ThreadDataKey \ + Tcl_ThreadId \ + Tcl_Time \ + Tcl_TimerToken \ + Tcl_Token \ + Tcl_Trace \ + Tcl_Value \ + Tcl_ValueType \ + Tcl_Var \ +} + +# Misc junk that appears in the comments of the source. This just +# allows us to filter comments that "fool" the script. + +set CommentList { + Tcl_Create\[Obj\]Command \ + Tcl_DecrRefCount\\n \ + Tcl_NewObj\\n \ +} + +# Main entry point to this script. + +proc main {} { + global argv0 + global argv + + set len [llength $argv] + if {($len != 2) && ($len != 3)} { + puts "usage: $argv0 pkgName pkgDir \[outFile\]" + puts " pkgName == Tcl,Tk" + puts " pkgDir == /home/surles/cvs/tcl8.1" + exit 1 + } + + set pkg [lindex $argv 0] + set dir [lindex $argv 1] + if {[llength $argv] == 3} { + set file [open [lindex $argv 2] w] + } else { + set file stdout + } + + foreach {c d} [compare [grepCode $dir $pkg] [grepDocs $dir $pkg]] {} + filter $c $d $dir $pkg $file + + if {$file != "stdout"} { + close $file + } + return +} + +# Intersect the two list and write out the sets of APIs in one +# list that is not in the other. + +proc compare {list1 list2} { + set inter [intersect3 $list1 $list2] + return [list [lindex $inter 0] [lindex $inter 2]] +} + +# Filter the lists into the six lists we report on. Then write +# the results to the file. + +proc filter {code docs dir pkg {outFile stdout}} { + # A list of Tcl command APIs. These are not documented. + # This list should just be verified for accuracy. + + set cmds {} + + # A list of proc pointer structs. These are not documented. + # This list should just be verified for accuracy. + + set procs {} + + # A list of internal declarations. These are not documented. + # This list should just be verified for accuracy. + + set decls [grepDecl $dir $pkg] + + # A list of misc. procedure declarations that are not documented. + # This list should just be verified for accuracy. + + set misc [grepMisc $dir $pkg] + + # A list of APIs in the source, not in the docs. + # This list should just be verified for accuracy. + + foreach x $code { + if {[string match *Cmd $x]} { + lappend cmds $x + } elseif {[string match *Proc $x]} { + lappend procs $x + } elseif {[lsearch -exact $decls $x] >= 0} { + # No Op. + } elseif {[lsearch -exact $misc $x] >= 0} { + # No Op. + } else { + lappend apis $x + } + } + + dump $apis "APIs in Source not in Docs." $outFile + dump $docs "APIs in Docs not in Source." $outFile + dump $decls "Internal APIs and structs." $outFile + dump $misc "Misc APIs and structs that we are not documenting." $outFile + dump $cmds "Command APIs." $outFile + dump $procs "Proc pointers." $outFile + return +} + +# Print the list of APIs if the list is not null. + +proc dump {list title file} { + if {$list != {}} { + puts $file "" + puts $file $title + puts $file "---------------------------------------------------------" + foreach x $list { + puts $file $x + } + } +} + +# Grep into "dir/*/*.[ch]" looking for APIs that match $pkg_*. +# (e.g., Tcl_Exit). Return a list of APIs. + +proc grepCode {dir pkg} { + set apis [exec grep "${pkg}_\.\*" "${dir}/\*/\*\.\[ch\]" | cat] + set pat1 ".*(Tcl_\[A-z0-9]+).*$" + + foreach a [split $apis "\n"] { + if {[regexp -- $pat1 $a main n1]} { + set result([string trim $n1]) 1 + } + } + return [lsort [array names result]] +} + +# Grep into "dir/doc/*.3" looking for APIs that match $pkg_*. +# (e.g., Tcl_Exit). Return a list of APIs. + +proc grepDocs {dir pkg} { + set apis [exec grep "\\fB${pkg}_\.\*\\fR" "${dir}/doc/\*\.3" | cat] + set pat1 ".*(Tcl_\[A-z0-9]+).*$" + + foreach a $apis { + if {[regexp -- $pat1 $a main n1]} { + set result([string trim $n1]) 1 + } + } + return [lsort [array names result]] +} + +# Grep into "generic/pkgIntDecls.h" looking for APIs that match $pkg_*. +# (e.g., Tcl_Export). Return a list of APIs. + +proc grepDecl {dir pkg} { + set file [file join $dir generic "[string tolower $pkg]IntDecls.h"] + set apis [exec grep "^EXTERN.*\[ \t\]Tcl_.*" $file | cat] + set pat1 ".*(Tcl_\[A-z0-9]+).*$" + + foreach a $apis { + if {[regexp -- $pat1 $a main n1]} { + set result([string trim $n1]) 1 + } + } + return [lsort [array names result]] +} + +# Grep into "*/*.[ch]" looking for APIs that match $pkg_Db*. +# (e.g., Tcl_DbCkalloc). Return a list of APIs. + +proc grepMisc {dir pkg} { + global CommentList + global StructList + + set apis [exec grep "^EXTERN.*\[ \t\]Tcl_Db.*" "${dir}/\*/\*\.\[ch\]" \ + | cat] + set pat1 ".*(Tcl_\[A-z0-9]+).*$" + + foreach a $apis { + if {[regexp -- $pat1 $a main n1]} { + set dbg([string trim $n1]) 1 + } + } + + set result {} + eval {lappend result} $StructList + eval {lappend result} [lsort [array names dbg]] + eval {lappend result} $CommentList + return $result +} + +main + |