bug fix to tclcl-1.0b6

[John Heidemann <johnh@ISI.EDU>]

There is a fairly serious bug in tclcl regarding memory allocation
where it tries to free memory twice when some objects are destroyed.
Apparently ns doesn't destroy objects very frequently because this
didn't turn up in the test suite at the last release.

If you have problems with random crashes, particluarly after you
destroy objects, please apply the following patch to tclcl/Tcl.cc and relink
ns.

   -John Heidemann


Index: Tcl.cc
===================================================================
RCS file: /usr/src/mash/repository/common/Tcl/Tcl.cc,v
retrieving revision 1.39
retrieving revision 1.41
diff -u -r1.39 -r1.41
--- Tcl.cc	1998/07/24 18:23:39	1.39
+++ Tcl.cc	1998/07/30 03:41:08	1.41
@@ -34,7 +34,7 @@
 
 #ifndef lint
 static const char rcsid[] =
-    "@(#) $Header: /usr/src/mash/repository/common/Tcl/Tcl.cc,v 1.39 1998/07/24 18:23:39 yatin Exp $ (LBL)";
+    "@(#) $Header: /usr/src/mash/repository/common/Tcl/Tcl.cc,v 1.41 1998/07/30 03:41:08 heideman Exp $ (LBL)";
 #endif
 
 #include <stdio.h>
@@ -96,6 +96,7 @@
 			       char* name1, char* name2, int flags);
 protected:
 	void catch_write(const char* name1, const char*);
+	void catch_destroy(const char* name1, const char*);
 	char* value_;
 };
 
@@ -239,20 +240,6 @@
 
 TclObject::~TclObject()
 {
-	/* XXX delete from hash table */
-	TracedVar* p;
-	for (p = tracedvar_;  p != 0; ) {
-		TracedVar* n = p->next_;
-		delete p;
-		p = n;
-	}
-
-	InstVar* q;
-	for (q = instvar_; q != 0; ) {
-		InstVar* n = q->next_;
-		delete q;
-		q = n;
-	}
 	delete[] name_;
 }
 
@@ -601,7 +588,7 @@
 	name_ = s;
 	Tcl& tcl = Tcl::instance();
 	Tcl_TraceVar(tcl.interp(), (char*)name,
-		     TCL_TRACE_WRITES,
+		     TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
 		     catch_var, (ClientData)this);
 }
 
@@ -631,12 +618,19 @@
 		tracer()->trace(this);
 }
 
+void TracedVarTcl::catch_destroy(const char* name1, const char*)
+{
+	delete this;
+}
+
 char* TracedVarTcl::catch_var(ClientData clientData, Tcl_Interp*,
 			      char* name1, char* name2, int flags)
 {
 	TracedVarTcl* p = (TracedVarTcl*)clientData;
 	if (flags & TCL_TRACE_WRITES)
 		p->catch_write(name1, name2);
+	else if ((flags & TCL_TRACE_UNSETS) && (flags & TCL_TRACE_DESTROYED))
+		p->catch_destroy(name1, name2);
 	return (0);
 }