summaryrefslogtreecommitdiffstats
path: root/tcl8.6/tools/findBadExternals.tcl
diff options
context:
space:
mode:
authorWilliam Joye <wjoye@cfa.harvard.edu>2018-01-02 21:03:49 (GMT)
committerWilliam Joye <wjoye@cfa.harvard.edu>2018-01-02 21:03:49 (GMT)
commit914501b5b992e7b6c7e0a4c958712a8ba9cab41c (patch)
treeedbc059b9557d5fdb79e5a5c47889bc54708da53 /tcl8.6/tools/findBadExternals.tcl
parentf88c190a01bc7f57e79dfaf91a3c0c48c2031549 (diff)
downloadblt-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-xtcl8.6/tools/findBadExternals.tcl53
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]