From ef18d8daab4aad16f833fe17fe8be97671eebe71 Mon Sep 17 00:00:00 2001
From: mescalinum <mescalinum@users.sourceforge.net>
Date: Mon, 28 Nov 2011 23:59:13 +0000
Subject: Fix pd_bind crash in [bitmap] (bug #3429577). This commit causes
 [bitmap] to break further, because there are now two string representations
 of a t_pd*: 1. the one provided by SWIG, unaccessible by tclpd; 2. the tclpd
 synthetic one In order to be fixed, hashtable must become a bidirectional
 hashmap, so that a reverse lookup in the object_table is possible (needed in
 order to make a %typemap(out) t_pd *).

svn path=/trunk/externals/loaders/tclpd/; revision=15801
---
 examples/bitmap.tcl | 18 +++++++++++++-----
 tclpd.i             |  8 ++++++++
 2 files changed, 21 insertions(+), 5 deletions(-)

diff --git a/examples/bitmap.tcl b/examples/bitmap.tcl
index e1d0495..c54d51f 100644
--- a/examples/bitmap.tcl
+++ b/examples/bitmap.tcl
@@ -60,13 +60,20 @@ proc+ bitmap::constructor {self args} {
     0_config $self {*}$args
 
     set @rcvLoadData {#bitmap}
+
+    set x [pd_findbyclass $@rcvLoadData bitmap]
+    if {$x ne "NULL"} {
+        # prevent crash due to stale bound receivers:
+        pd_unbind $x $@rcvLoadData
+    }
+
     pd_bind $self $@rcvLoadData
 }
 
 proc+ bitmap::destructor {self} {
-    if {$@rcvLoadData ne {}} {
-        #should not happen!
-        pd_unbind $self $@rcvLoadData
+    set x [pd_findbyclass $@rcvLoadData bitmap]
+    if {$x ne "NULL"} {
+        pd_unbind $x $@rcvLoadData
     }
     if {[dict get $@config -receivesymbol] ne {}} {
         pd_unbind $self $@recv
@@ -248,9 +255,10 @@ proc+ bitmap::0_setdata {self args} {
     }
     set @data [list]
     foreach i $d {lappend @data [expr {int($i)}]}
-    if {$@rcvLoadData ne {}} {
+
+    set x [pd_findbyclass $@rcvLoadData bitmap]
+    if {$x ne "NULL"} {
         pd_unbind $self $@rcvLoadData
-        set @rcvLoadData {}
     }
 }
 
diff --git a/tclpd.i b/tclpd.i
index a072f5b..4d889d0 100644
--- a/tclpd.i
+++ b/tclpd.i
@@ -88,6 +88,7 @@ void name_setitem(type *ary, int index, type value)
     const char *str = Tcl_GetStringFromObj($input, NULL);
     $1 = object_table_get(str);
     SWIG_contract_assert($1, "not a t_pd * instance") {};
+    // XXX: %typemap(out) missing!!!
 }
 
 %typemap(in) t_text * {
@@ -107,6 +108,13 @@ void name_setitem(type *ary, int index, type value)
     $1 = &x->o;
 }
 
+%typemap(in) struct _class * {
+    const char *str = Tcl_GetStringFromObj($input, NULL);
+    t_class *c = class_table_get(str);
+    SWIG_contract_assert(c, "invalid class name") {};
+    $1 = c;
+}
+
 /* functions that are in m_pd.h but don't exist in modern versions of pd */
 %ignore pd_getfilename;
 %ignore pd_getdirname;
-- 
cgit v1.2.1