Fix memory and type management bugs.

diff --git a/base/chiark-tcl.h b/base/chiark-tcl.h
index ac19c8f9cd941f2ac1aa95fcd2a7daee442e601a..c9975f2adea212c8fd1602dcb0c6a9bd2e73bbf4 100644 (file)
--- a/base/chiark-tcl.h
+++ b/base/chiark-tcl.h
@@ -15,7 +15,7 @@
  *
  *  hbytes range VALUE START SIZE                => substring (or error)
  *  hbytes overwrite VAR START VALUE
- *  hbytes trimleft VALUE                        removes any leading 0 octets
+ *  hbytes trimleft VAR                         removes any leading 0 octets
  *  hbytes repeat VALUE COUNT                    => COUNT copies of VALUE
  *
  *  hbytes clockincrement VAR INTEGER      adds INTEGER to VAR mod 256^|VAR|
@@ -175,6 +175,7 @@ void obj_updatestr_string(Tcl_Obj *o, const char *str);
 typedef struct {
   HBytes_Value *hb;
   Tcl_Obj *obj, *var;
+  int copied;
 } HBytes_Var;
 
 void fini_hbv(Tcl_Interp *ip, int rc, HBytes_Var *agg);

diff --git a/base/enum.c b/base/enum.c
index 8041cd378a5b05f1c486f2f4049700299f91c631..e3fa041b6d621875909bb06c84a0e23011555785 100644 (file)
--- a/base/enum.c
+++ b/base/enum.c
@@ -8,6 +8,7 @@
 
 static void enum_nt_dup(Tcl_Obj *src, Tcl_Obj *dup) {
   dup->internalRep= src->internalRep;
+  dup->typePtr= src->typePtr;
 }
 
 static void enum_nt_ustr(Tcl_Obj *o) {

diff --git a/base/hook.c b/base/hook.c
index 0adb6b5d5804bb54e7669ef485987a69fb38a9a9..cdcb246d2c742b945ad8444faad1cd1705529b01 100644 (file)
--- a/base/hook.c
+++ b/base/hook.c
@@ -61,10 +61,10 @@ int do_hbytes_rep_info(ClientData cd, Tcl_Interp *ip,
 }
 
 static void hbytes_t_dup(Tcl_Obj *src, Tcl_Obj *dup) {
-  objfreeir(dup);
   hbytes_array(OBJ_HBYTES(dup),
               hbytes_data(OBJ_HBYTES(src)),
               hbytes_len(OBJ_HBYTES(src)));
+  dup->typePtr= &hbytes_type;
 }
 
 static void hbytes_t_free(Tcl_Obj *o) {

diff --git a/base/parse.c b/base/parse.c
index b81511cc827e0c45d1cb53bfe318c74cb1a34cfe..c203be15ea7621f806e02601b85273ea7c99e4ec 100644 (file)
--- a/base/parse.c
+++ b/base/parse.c
@@ -30,31 +30,35 @@ int pat_hbv(Tcl_Interp *ip, Tcl_Obj *var, HBytes_Var *agg) {
   int rc;
   Tcl_Obj *val;
 
-  Tcl_IncrRefCount(var);
   agg->var= var;
 
   val= Tcl_ObjGetVar2(ip,var,0,TCL_LEAVE_ERR_MSG);
   if (!val) return TCL_ERROR;
-  if (Tcl_IsShared(val)) val= Tcl_DuplicateObj(val);
-  Tcl_IncrRefCount(val);
-  agg->obj= val;
-  
+
   rc= Tcl_ConvertToType(ip,val,&hbytes_type);
   if (rc) return rc;
 
-  agg->hb= OBJ_HBYTES(val); return TCL_OK; }
+  Tcl_InvalidateStringRep(val);
+  if (Tcl_IsShared(val)) {
+    val= Tcl_DuplicateObj(val);
+    agg->copied= 1;
+  }
+  agg->obj= val;
+
+  agg->hb= OBJ_HBYTES(val);
+  return TCL_OK;
+}
 
 void fini_hbv(Tcl_Interp *ip, int rc, HBytes_Var *agg) {
   Tcl_Obj *ro;
   
-  if (agg->obj) Tcl_InvalidateStringRep(agg->obj);
   if (!rc) {
     assert(agg->obj);
     ro= Tcl_ObjSetVar2(ip,agg->var,0,agg->obj,TCL_LEAVE_ERR_MSG);
     if (!ro) rc= TCL_ERROR;
   }
-  if (agg->obj) Tcl_DecrRefCount(agg->obj);
-  if (agg->var) Tcl_DecrRefCount(agg->var);
+  if (rc && agg->copied)
+    Tcl_DecrRefCount(agg->obj);
 }
 
 int pat_hb(Tcl_Interp *ip, Tcl_Obj *obj, HBytes_Value *val) {

diff --git a/base/tables-examples.tct b/base/tables-examples.tct
index c130136bc094ba3079aa276d07cd5ce824fb0fb5..9a19c5a7676467fb401baebdc431c1b4f79e3fc9 100644 (file)
--- a/base/tables-examples.tct
+++ b/base/tables-examples.tct
@@ -2,7 +2,7 @@ Type hb:                        HBytes_Value @
 Init hb                                hbytes_sentinel(&@);
 
 Type hbv:                      HBytes_Var @
-Init hbv                       @.hb=0; @.obj=0; @.var=0;
+Init hbv                       @.hb=0; @.obj=0; @.var=0; @.copied=0;
 Fini hbv                       fini_hbv(ip, rc, &@);
 
 Type sockaddr:                 SockAddr_Value @

diff --git a/base/tcmdifgen b/base/tcmdifgen
index dce3153f3ac0e3247d2ff6822134ac29a1276001..14567703c2129f95b05e3f65f95f4a02cec3c4e3 100755 (executable)
--- a/base/tcmdifgen
+++ b/base/tcmdifgen
@@ -248,7 +248,7 @@ foreach $c_table (sort keys %tables) {
            $pa_vars .= "  const char *e;\n";
            $pa_fini .= "\n";
            $pa_fini .= "e_err:\n";
-           $pa_fini .= "  setstringresult(ip,e);";
+           $pa_fini .= "  setstringresult(ip,e);\n";
            $pa_fini .= "  rc= TCL_ERROR; goto rc_err;\n";
        }
        $pa_vars .= "\n";

diff --git a/crypto/crypto.c b/crypto/crypto.c
index efddecd669885311eca67dc59991176a86a59814..457dc9e37f242178a55b13acea3732199b7d8546 100644 (file)
--- a/crypto/crypto.c
+++ b/crypto/crypto.c
@@ -102,6 +102,7 @@ static void key_t_dup(Tcl_Obj *src_obj, Tcl_Obj *dup_obj) {
   memcpy(dup->value, src->value, src->valuelen);
   noalg(dup);
   dup_obj->internalRep.otherValuePtr= dup;
+  dup_obj->typePtr= &blockcipherkey_type;
 }
 
 static void key_t_ustr(Tcl_Obj *o) {

diff --git a/dgram/dgram.c b/dgram/dgram.c
index bb538bf2f1b4d11c9ff39d6ee0be7de6cd602aa7..0dd40aae056901666c0d196664ce0372d6846fea 100644 (file)
--- a/dgram/dgram.c
+++ b/dgram/dgram.c
@@ -146,17 +146,14 @@ static void recv_call(ClientData sock_cd, int mask) {
   Tcl_IncrRefCount(invoke);
 
   rc= Tcl_ListObjReplace(ip,invoke,sock->script_llength,0,3,args);
+  for (i=0; i<3; i++) { Tcl_DecrRefCount(args[i]); args[i]= 0; }
   if (rc) goto x_rc;
 
   rc= Tcl_EvalObjEx(ip,invoke,TCL_EVAL_GLOBAL|TCL_EVAL_DIRECT);
 
-  for (i=0; i<3; i++) Tcl_DecrRefCount(args[i]);
-  Tcl_DecrRefCount(invoke);
-
-  hbytes_free(&message_val);
-  sockaddr_free(&peer_val);
-
 x_rc:
+  if (invoke) Tcl_DecrRefCount(invoke);
+
   if (rc)
     Tcl_BackgroundError(ip);
 }
@@ -225,6 +222,7 @@ static void sockid_t_free(Tcl_Obj *o) { }
 
 static void sockid_t_dup(Tcl_Obj *src, Tcl_Obj *dup) {
   dup->internalRep= src->internalRep;
+  dup->typePtr= &dgramsockid_type;
 }
 
 static void sockid_t_ustr(Tcl_Obj *o) {

diff --git a/dgram/sockaddr.c b/dgram/sockaddr.c
index 2a388d018226f63603088421f86fc9dc24af9879..a191cac93d99e5b7702895343197d28c7f6ceff1 100644 (file)
--- a/dgram/sockaddr.c
+++ b/dgram/sockaddr.c
@@ -62,10 +62,10 @@ void sockaddr_free(const SockAddr_Value *v) {
 /* Sockaddr Tcl type */
 
 static void sockaddr_t_dup(Tcl_Obj *src, Tcl_Obj *dup) {
-  objfreeir(dup);
   sockaddr_create(OBJ_SOCKADDR(dup),
                  sockaddr_addr(OBJ_SOCKADDR(src)),
                  sockaddr_len(OBJ_SOCKADDR(src)));
+  dup->typePtr= &hbytes_type;
 }
 
 static void sockaddr_t_free(Tcl_Obj *o) {

diff --git a/hbytes/hbytes.h b/hbytes/hbytes.h
index ac19c8f9cd941f2ac1aa95fcd2a7daee442e601a..c9975f2adea212c8fd1602dcb0c6a9bd2e73bbf4 100644 (file)
--- a/hbytes/hbytes.h
+++ b/hbytes/hbytes.h
@@ -15,7 +15,7 @@
  *
  *  hbytes range VALUE START SIZE                => substring (or error)
  *  hbytes overwrite VAR START VALUE
- *  hbytes trimleft VALUE                        removes any leading 0 octets
+ *  hbytes trimleft VAR                         removes any leading 0 octets
  *  hbytes repeat VALUE COUNT                    => COUNT copies of VALUE
  *
  *  hbytes clockincrement VAR INTEGER      adds INTEGER to VAR mod 256^|VAR|
@@ -175,6 +175,7 @@ void obj_updatestr_string(Tcl_Obj *o, const char *str);
 typedef struct {
   HBytes_Value *hb;
   Tcl_Obj *obj, *var;
+  int copied;
 } HBytes_Var;
 
 void fini_hbv(Tcl_Interp *ip, int rc, HBytes_Var *agg);

diff --git a/hbytes/hook.c b/hbytes/hook.c
index 0adb6b5d5804bb54e7669ef485987a69fb38a9a9..cdcb246d2c742b945ad8444faad1cd1705529b01 100644 (file)
--- a/hbytes/hook.c
+++ b/hbytes/hook.c
@@ -61,10 +61,10 @@ int do_hbytes_rep_info(ClientData cd, Tcl_Interp *ip,
 }
 
 static void hbytes_t_dup(Tcl_Obj *src, Tcl_Obj *dup) {
-  objfreeir(dup);
   hbytes_array(OBJ_HBYTES(dup),
               hbytes_data(OBJ_HBYTES(src)),
               hbytes_len(OBJ_HBYTES(src)));
+  dup->typePtr= &hbytes_type;
 }
 
 static void hbytes_t_free(Tcl_Obj *o) {

diff --git a/hbytes/parse.c b/hbytes/parse.c
index b81511cc827e0c45d1cb53bfe318c74cb1a34cfe..c203be15ea7621f806e02601b85273ea7c99e4ec 100644 (file)
--- a/hbytes/parse.c
+++ b/hbytes/parse.c
@@ -30,31 +30,35 @@ int pat_hbv(Tcl_Interp *ip, Tcl_Obj *var, HBytes_Var *agg) {
   int rc;
   Tcl_Obj *val;
 
-  Tcl_IncrRefCount(var);
   agg->var= var;
 
   val= Tcl_ObjGetVar2(ip,var,0,TCL_LEAVE_ERR_MSG);
   if (!val) return TCL_ERROR;
-  if (Tcl_IsShared(val)) val= Tcl_DuplicateObj(val);
-  Tcl_IncrRefCount(val);
-  agg->obj= val;
-  
+
   rc= Tcl_ConvertToType(ip,val,&hbytes_type);
   if (rc) return rc;
 
-  agg->hb= OBJ_HBYTES(val); return TCL_OK; }
+  Tcl_InvalidateStringRep(val);
+  if (Tcl_IsShared(val)) {
+    val= Tcl_DuplicateObj(val);
+    agg->copied= 1;
+  }
+  agg->obj= val;
+
+  agg->hb= OBJ_HBYTES(val);
+  return TCL_OK;
+}
 
 void fini_hbv(Tcl_Interp *ip, int rc, HBytes_Var *agg) {
   Tcl_Obj *ro;
   
-  if (agg->obj) Tcl_InvalidateStringRep(agg->obj);
   if (!rc) {
     assert(agg->obj);
     ro= Tcl_ObjSetVar2(ip,agg->var,0,agg->obj,TCL_LEAVE_ERR_MSG);
     if (!ro) rc= TCL_ERROR;
   }
-  if (agg->obj) Tcl_DecrRefCount(agg->obj);
-  if (agg->var) Tcl_DecrRefCount(agg->var);
+  if (rc && agg->copied)
+    Tcl_DecrRefCount(agg->obj);
 }
 
 int pat_hb(Tcl_Interp *ip, Tcl_Obj *obj, HBytes_Value *val) {

diff --git a/hbytes/ulongs.c b/hbytes/ulongs.c
index f8b8c9e722d1ed6fc303e9ca9f6baa43ce3ed8b4..ac8793392e45c2ee19282c55c3ea849946f823c2 100644 (file)
--- a/hbytes/ulongs.c
+++ b/hbytes/ulongs.c
@@ -290,6 +290,7 @@ static void ulong_t_free(Tcl_Obj *o) { }
 
 static void ulong_t_dup(Tcl_Obj *src, Tcl_Obj *dup) {
   dup->internalRep= src->internalRep;
+  dup->typePtr= &ulong_type;
 }
 
 static void ulong_t_ustr(Tcl_Obj *o) {