diff options
author | William Joye <wjoye@cfa.harvard.edu> | 2018-01-02 21:03:49 (GMT) |
---|---|---|
committer | William Joye <wjoye@cfa.harvard.edu> | 2018-01-02 21:03:49 (GMT) |
commit | 914501b5b992e7b6c7e0a4c958712a8ba9cab41c (patch) | |
tree | edbc059b9557d5fdb79e5a5c47889bc54708da53 /tcl8.6/tools/findBadExternals.tcl | |
parent | f88c190a01bc7f57e79dfaf91a3c0c48c2031549 (diff) | |
download | blt-914501b5b992e7b6c7e0a4c958712a8ba9cab41c.zip blt-914501b5b992e7b6c7e0a4c958712a8ba9cab41c.tar.gz blt-914501b5b992e7b6c7e0a4c958712a8ba9cab41c.tar.bz2 |
upgrade to tcl/tk 8.6.8
Diffstat (limited to 'tcl8.6/tools/findBadExternals.tcl')
-rwxr-xr-x | tcl8.6/tools/findBadExternals.tcl | 53 |
1 files changed, 53 insertions, 0 deletions
diff --git a/tcl8.6/tools/findBadExternals.tcl b/tcl8.6/tools/findBadExternals.tcl new file mode 100755 index 0000000..2228357 --- /dev/null +++ b/tcl8.6/tools/findBadExternals.tcl @@ -0,0 +1,53 @@ +# findBadExternals.tcl -- +# +# This script scans the Tcl load library for exported symbols +# that do not begin with 'Tcl' or 'tcl'. It reports them on the +# standard output. It is used to make sure that the library does +# not inadvertently export externals that may be in conflict with +# other code. +# +# Usage: +# +# tclsh findBadExternals.tcl /path/to/tclXX.so-or-.dll +# +# Copyright (c) 2005 George Peter Staplin and Kevin Kenny +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +#---------------------------------------------------------------------- + +proc main {argc argv} { + + if {$argc != 1} { + puts stderr "syntax is: [info script] libtcl" + return 1 + } + + + switch -exact -- $::tcl_platform(platform) { + unix - + macosx { + set status [catch { + exec nm --extern-only --defined-only [lindex $argv 0] + } result] + } + windows { + set status [catch { + exec dumpbin /exports [lindex $argv 0] + } result] + } + } + if {$status != 0 && $::errorCode ne "NONE"} { + puts $result + return 1 + } + + foreach line [split $result \n] { + if {! [string match {* [Tt]cl*} $line]} { + puts $line + } + } + + return 0 +} +exit [main $::argc $::argv] |