summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog7
-rwxr-xr-xtools/findBadExternals.tcl56
2 files changed, 63 insertions, 0 deletions
diff --git a/ChangeLog b/ChangeLog
index d8e46ca..cf3989b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2005-11-04 Kevin Kenny <kennykb@acm.org>
+
+ * tools/findBadExternals.tcl: Added this script, which locates
+ external symbols that do not begin with 'Tcl' or 'tcl' and hence
+ might be in conflict with other link libraries. Thanks to George
+ Peter Staplin for the idea and the initial version of the script.
+
2005-11-04 Miguel Sofer <msofer@users.sf.net>
* generic/tclInt.h:
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]