summaryrefslogtreecommitdiffstats
path: root/tools
diff options
context:
space:
mode:
authorKevin B Kenny <kennykb@acm.org>2005-11-04 19:37:57 (GMT)
committerKevin B Kenny <kennykb@acm.org>2005-11-04 19:37:57 (GMT)
commit60960f3a10929968b97a427fd1ce508fbf1b2eea (patch)
tree0d4601edd048c659ebf68c03518dbd5378024107 /tools
parentf30e4208875db88eacedeabb363d94c5dbcc32ce (diff)
downloadtcl-60960f3a10929968b97a427fd1ce508fbf1b2eea.zip
tcl-60960f3a10929968b97a427fd1ce508fbf1b2eea.tar.gz
tcl-60960f3a10929968b97a427fd1ce508fbf1b2eea.tar.bz2
Bug 1263012
Diffstat (limited to 'tools')
-rwxr-xr-xtools/findBadExternals.tcl56
1 files changed, 56 insertions, 0 deletions
diff --git a/tools/findBadExternals.tcl b/tools/findBadExternals.tcl
new file mode 100755
index 0000000..6696801
--- /dev/null
+++ b/tools/findBadExternals.tcl
@@ -0,0 +1,56 @@
+# 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.
+#
+# RCS: @(#) $Id: findBadExternals.tcl,v 1.1 2005/11/04 19:37:57 kennykb Exp $
+#
+#----------------------------------------------------------------------
+
+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]