Fix a few bugs in the tcl module related to clientdata propagation.

git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk/SWIG@6357 626c5289-ae23-0410-ae9c-e8d60b6d4f22

CHANGES.current

@@ -1,6 +1,28 @@
 Version 1.3.23 (in progress)
 ============================
 
+10/06/2004: wuzzeb (John Lenz)
+            [TCL]
+            - Fix bug reported by William A. Hoffman propagating clientdata
+            between modules.  Added clientdata_prop.multicpptest to check for
+            this bug.  The fix involved the following changes:
+                + SwigType_clientdata_collect does not need to check
+                types in r_resolved because we only want to propagate clientdata
+                to typedefed classes, and r_mangled already takes care of typedefs.
+
+                + SWIG_TypeRegister now copies the clientdata field correctly
+
+                + Move SWIG_Guile_PropagateClientData function from guile module
+                into common.swg, because we need to call it from both guile and tcl.
+
+                + Add base_names to swig_class to delay the lookup of bases.  SWIG
+                now exports the base names and only when the base swig_class is
+                needed is SWIG_TypeQuery(name)->clientdata looked up.
+
+            - conversion_ns_template testsuite test was failing because
+            the name of the wrapped constructor function was not calculated
+            correctly for structs.  Fixed.
+
 10/06/2004: wsfulton
             Fixes for default arguments used in directors - in virtual
             methods and director constructors.

Examples/test-suite/clientdata_prop.list

@@ -0,0 +1,2 @@
+clientdata_prop_a
+clientdata_prop_b

Examples/test-suite/clientdata_prop_a.h

@@ -0,0 +1,12 @@
+
+class A {
+  public:
+    void fA() {}
+};
+
+typedef A tA;
+
+void test_A(A *a) {}
+void test_tA(tA *a) {}
+
+tA *new_tA() { return new tA(); }

Examples/test-suite/clientdata_prop_a.i

@@ -0,0 +1,12 @@
+/* This file tests the clientdata propagation at swig wrapper
+   generation.  It tests a bug in the TCL module where the
+   clientdata was not propagated correctly to all classes */
+
+%module clientdata_prop_a
+%{
+  #include "clientdata_prop_a.h"
+%}
+
+%include "clientdata_prop_a.h"
+
+%newobject new_tA;

Examples/test-suite/clientdata_prop_b.h

@@ -0,0 +1,38 @@
+#include "clientdata_prop_a.h"
+
+typedef tA t2A;
+typedef A t3A;
+
+class B : public A
+{
+  public:
+    void fB() {}
+};
+
+class C : public tA
+{
+  public:
+    void fC() {}
+};
+
+class D : public t2A
+{
+  public:
+    void fD() {}
+};
+
+typedef D tD;
+typedef tD t2D;
+
+void test_t2A(t2A *a) {}
+void test_t3A(t3A *a) {}
+void test_B(B *b) {}
+void test_C(C *c) {}
+void test_D(D *d) {}
+void test_tD(tD *d) {}
+void test_t2D(t2D *d) {}
+
+t2A *new_t2A() { return new t2A(); }
+t3A *new_t3A() { return new t3A(); }
+tD * new_tD () { return new tD (); }
+t2D *new_t2D() { return new t2D(); }

Examples/test-suite/clientdata_prop_b.i

@@ -0,0 +1,20 @@
+/* This file tests the clientdata propagation at swig wrapper
+   generation.  It tests a bug in the TCL module where the
+   clientdata was not propagated correctly to all classes */
+
+%module clientdata_prop_b
+
+%{
+#include "clientdata_prop_b.h"
+%}
+
+%import "clientdata_prop_a.i"
+
+%include "clientdata_prop_b.h"
+
+%types(tA *);
+
+%newobject new_t2A;
+%newobject new_t3A;
+%newobject new_tD;
+%newobject new_t2D;

Examples/test-suite/clientdata_prop_runtime.i

@@ -0,0 +1 @@
+%module clientdata_prop_runtime

Examples/test-suite/common.mk

@@ -323,6 +323,7 @@ C_TEST_CASES += \
 
 # Multi-module C++ test cases . (Can be run individually using make testcase.multicpptest.)
 MULTI_CPP_TEST_CASES += \
+	clientdata_prop \
 	imports \
 	template_typedef_import
 

Examples/test-suite/tcl/clientdata_prop_runme.tcl

@@ -0,0 +1,88 @@
+
+if [ catch { load ./clientdata_prop_b[info sharedlibextension] clientdata_prop_b} err_msg ] {
+  puts stderr "Could not load shared object:\n$err_msg"
+  exit 1
+}
+if [ catch { load ./clientdata_prop_a[info sharedlibextension] clientdata_prop_a} err_msg ] {
+  puts stderr "Could not load shared object:\n$err_msg"
+  exit 1
+}
+
+A a
+test_A a
+test_tA a
+test_t2A a
+test_t3A a
+a fA
+
+B b
+test_A b
+test_tA b
+test_t2A b
+test_t3A b
+test_B b
+b fA
+b fB
+
+C c
+test_A c
+test_tA c
+test_t2A c
+test_t3A c
+test_C c
+c fA
+c fC
+
+D d
+test_A d
+test_tA d
+test_t2A d
+test_t3A d
+test_D d
+test_tD d
+test_t2D d
+d fA
+d fD
+
+set a2 [new_tA]
+test_A $a2
+test_tA $a2
+test_t2A $a2
+test_t3A $a2
+$a2 fA
+
+set a3 [new_t2A]
+test_A $a3
+test_tA $a3
+test_t2A $a3
+test_t3A $a3
+$a3 fA
+
+set a4 [new_t3A]
+test_A $a4
+test_tA $a4
+test_t2A $a4
+test_t3A $a4
+$a4 fA
+
+set d2 [new_tD]
+test_A $d2
+test_tA $d2
+test_t2A $d2
+test_t3A $d2
+test_D $d2
+test_tD $d2
+test_t2D $d2
+$d2 fA
+$d2 fD
+
+set d3 [new_t2D]
+test_A $d3
+test_tA $d3
+test_t2A $d3
+test_t3A $d3
+test_D $d3
+test_tD $d3
+test_t2D $d3
+$d3 fA
+$d3 fD

Examples/test-suite/tcl/imports_runme.tcl

@@ -1,15 +1,19 @@
 
 # This is the imports runtime testcase. 
 
-if [ catch { load ./imports_a[info sharedlibextension] imports_a} err_msg ] {
+if [ catch { load ./imports_b[info sharedlibextension] imports_b} err_msg ] {
 	puts stderr "Could not load shared object:\n$err_msg"
 	exit 1
 }
-if [ catch { load ./imports_b[info sharedlibextension] imports_b} err_msg ] {
+if [ catch { load ./imports_a[info sharedlibextension] imports_a} err_msg ] {
 	puts stderr "Could not load shared object:\n$err_msg"
 exit 1
 }
 
 set x [new_B]
 A_hello $x
-
+if [ catch { $x nonexistant } ] {
+} else {
+  puts stderr "nonexistant method did not throw exception\n"
+  exit 1
+}

Lib/common.swg

@@ -62,6 +62,7 @@ SWIGIMPORT(swig_type_info *) SWIG_TypeQuery(const char *);
 SWIGIMPORT(void)             SWIG_TypeClientData(swig_type_info *, void *);
 SWIGIMPORT(char *)           SWIG_PackData(char *, void *, int);
 SWIGIMPORT(char *)           SWIG_UnpackData(char *, void *, int);
+SWIGIMPORT(void)             SWIG_PropagateClientData(swig_type_info *type);
 
 #else
 
@@ -77,7 +78,7 @@ SWIG_TypeRegister(swig_type_info *ti) {
   while (tc) {
     if (strcmp(tc->name, ti->name) == 0) {
       /* Already exists in the table.  Just add additional types to the list */
-      if (tc->clientdata) ti->clientdata = tc->clientdata;
+      if (ti->clientdata) tc->clientdata = ti->clientdata;
       head = tc;
       next = tc->next;
       goto l1;
@@ -104,6 +105,7 @@ SWIG_TypeRegister(swig_type_info *ti) {
   }
   if (next) next->prev = head;
   head->next = next;
+
   return ret;
 }
 
@@ -285,6 +287,29 @@ SWIG_UnpackData(char *c, void *ptr, size_t sz) {
   return c;
 }
 
+/* This function will propagate the clientdata field of type to
+* any new swig_type_info structures that have been added into the list
+* of equivalent types.  It is like calling
+* SWIG_TypeClientData(type, clientdata) a second time.
+*/
+SWIGRUNTIME(void) 
+SWIG_PropagateClientData(swig_type_info *type) {
+  swig_type_info *equiv = type->next;
+  swig_type_info *tc;
+  if (!type->clientdata) return;
+  while (equiv) {
+    if (!equiv->converter) {
+      tc = *swig_type_list_handle;
+      while (tc) {
+        if ((strcmp(tc->name, equiv->name) == 0) && !tc->clientdata)
+          SWIG_TypeClientData(tc, type->clientdata);
+        tc = tc->prev;
+      }
+    }
+    equiv = equiv->next;
+  }
+}
+
 #endif
 
 #ifdef __cplusplus

Lib/guile/guile_scm_run.swg

@@ -42,8 +42,6 @@ typedef struct swig_guile_clientdata {
   SWIG_Guile_IsPointerOfType(object, type)
 #define SWIG_IsPointer(object) \
   SWIG_Guile_IsPointer(object)
-#define SWIG_PropagateClientData(type) \
-  SWIG_Guile_PropagateClientData(type)
 #define SWIG_contract_assert(expr, msg)				\
   if (!(expr))							\
     scm_error(scm_str2symbol("swig-contract-assertion-failed"),	\
@@ -67,9 +65,6 @@ SWIGIMPORT(void *) SWIG_Guile_MustGetPtr(SCM s, swig_type_info *type, int argnum
 SWIGIMPORT(SCM) SWIG_Guile_NewPointerObj(void *ptr, swig_type_info *type, int owner);
 /* Get arguments from an argument list */
 SWIGIMPORT(int) SWIG_Guile_GetArgs(SCM *dest, SCM rest, int reqargs, int optargs, const char *procname);
-/* Propagate client data to equivalent types */
-SWIGIMPORT(void) 
-SWIG_Guile_PropagateClientData(swig_type_info *type);
 /* Make a pointer object non-collectable */
 SWIGIMPORT(void)
 SWIG_Guile_MarkPointerNoncollectable(SCM s);
@@ -417,29 +412,6 @@ SWIG_Guile_GetArgs (SCM *dest, SCM rest,
   return num_args_passed;
 }
 
-/* This function will propagate the clientdata field of type to
-* any new swig_type_info structures that have been added into the list
-* of equivalent types.  It is like calling
-* SWIG_TypeClientData(type, clientdata) a second time.
-*/
-SWIGRUNTIME(void) 
-SWIG_Guile_PropagateClientData(swig_type_info *type) {
-  swig_type_info *equiv = type->next;
-  swig_type_info *tc;
-  if (!type->clientdata) return;
-  while (equiv) {
-    if (!equiv->converter) {
-      tc = swig_type_list;
-      while (tc) {
-        if ((strcmp(tc->name, equiv->name) == 0) && !tc->clientdata)
-          SWIG_TypeClientData(tc, type->clientdata);
-        tc = tc->prev;
-      }
-    }
-    equiv = equiv->next;
-  }
-}
-
 #endif
 
 #ifdef __cplusplus

Lib/tcl/swigtcl8.swg

@@ -63,6 +63,7 @@ typedef struct swig_class {
   swig_method        *methods;
   swig_attribute     *attributes;
   struct swig_class **bases;
+  char              **base_names;
 } swig_class;
 
 typedef struct swig_instance {
@@ -525,6 +526,11 @@ SWIG_Tcl_MethodCommand(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_
     bi = cls_stack_bi[cls_stack_top];
     cls = cls_stack[cls_stack_top];
     if (bi != -1) {
+      if (!cls->bases[bi] && cls->base_names[bi]) {
+        /* lookup and cache the base class */
+	swig_type_info *info = SWIG_TypeQuery(cls->base_names[bi]);
+	if (info) cls->bases[bi] = (swig_class *) info->clientdata;
+      }
       cls = cls->bases[bi];
       if (cls) {
         cls_stack_bi[cls_stack_top]++;

Lib/tcl/tcl8.swg

@@ -670,6 +670,9 @@ SWIGEXPORT(int) SWIG_init(Tcl_Interp *interp) {
        for (i = 0; swig_types_initial[i]; i++) {
           swig_types[i] = SWIG_TypeRegister(swig_types_initial[i]);
        }
+       for (i = 0; swig_types_initial[i]; i++) {
+          SWIG_PropagateClientData(swig_types[i]);
+       }
        _init = 1;
     }
     for (i = 0; swig_commands[i].name; i++) {

Source/Modules/tcl8.cxx

@@ -43,6 +43,7 @@ static int         nspace = 0;
 static String     *init_name = 0;
 static String     *ns_name = 0;
 static int         have_constructor;
+static String     *constructor_name;
 static int         have_destructor;
 static int         have_base_classes;
 static String     *destructor_action = 0;
@@ -747,6 +748,7 @@ public:
     /* Handle inheritance */
   
     String *base_class = NewString("");
+    String *base_class_names = NewString("");
 
     if( itcl ) {
       base_classes    = NewString("");
@@ -772,10 +774,11 @@ public:
 	//	Printv(f_wrappers,"extern swig_class _wrap_class_", bmangle, ";\n", NIL);
 	//	Printf(base_class,"&_wrap_class_%s",bmangle);
 	Printf(base_class,"0");
+	Printf(base_class_names,"\"%s *\",", SwigType_namestr(bname));
 	/* Put code to register base classes in init function */
 	
-	Printf(f_init,"/* Register base : %s */\n", bmangle);
-	Printf(f_init,"swig_%s_bases[%d] = (swig_class *) SWIG_TypeQuery(\"%s *\")->clientdata;\n",  mangled_classname, index, SwigType_namestr(bname));
+	//Printf(f_init,"/* Register base : %s */\n", bmangle);
+	//Printf(f_init,"swig_%s_bases[%d] = (swig_class *) SWIG_TypeQuery(\"%s *\")->clientdata;\n",  mangled_classname, index, SwigType_namestr(bname));
 	b = Next(b);
 	index++;
 	Putc(',',base_class);
@@ -885,13 +888,17 @@ public:
     };
 
     Printv(f_wrappers,"static swig_class *swig_",mangled_classname,"_bases[] = {", base_class,"0};\n", NIL);
+    Printv(f_wrappers,"static char *swig_",mangled_classname,"_base_names[] = {", base_class_names,"0};\n", NIL);
     Delete(base_class);
+    Delete(base_class_names);
 
     Printv(f_wrappers, "swig_class _wrap_class_", mangled_classname, " = { \"", class_name,
 	   "\", &SWIGTYPE", SwigType_manglestr(t), ",",NIL);
   
     if (have_constructor) {
-      Printf(f_wrappers,"%s", Swig_name_wrapper(Swig_name_construct(class_name)));
+      Printf(f_wrappers,"%s", Swig_name_wrapper(Swig_name_construct(constructor_name)));
+      Delete(constructor_name);
+      constructor_name = 0;
     } else {
       Printf(f_wrappers,"0");
     }
@@ -900,7 +907,8 @@ public:
     } else {
       Printf(f_wrappers,",0");
     }
-    Printv(f_wrappers, ", swig_", mangled_classname, "_methods, swig_", mangled_classname, "_attributes, swig_", mangled_classname,"_bases };\n", NIL);
+    Printv(f_wrappers, ", swig_", mangled_classname, "_methods, swig_", mangled_classname, "_attributes, swig_", mangled_classname,"_bases,",
+		         "swig_", mangled_classname, "_base_names };\n", NIL);
 
     if( !itcl ) {
       Printv(cmd_tab, tab4, "{ SWIG_prefix \"", class_name, "\", (swig_wrapper_func) SWIG_ObjectConstructor, &_wrap_class_", mangled_classname, "},\n", NIL);
@@ -1141,6 +1149,7 @@ public:
       }
     }
 
+    constructor_name = NewString(Getattr(n, "sym:name"));
     have_constructor = 1;
     return SWIG_OK;
   }

Source/Swig/typesys.c

@@ -1420,44 +1420,20 @@ List *SwigType_equivalent_mangle(String *ms, Hash *checked, Hash *found) {
  * ----------------------------------------------------------------------------- */
 
 static
-String *SwigType_clientdata_collect(String *ms, Hash *checked) {
-  Hash *ch;
+String *SwigType_clientdata_collect(String *ms) {
   Hash *mh;
   String *clientdata = 0;
 
-  if (checked) {
-    ch = checked;
-  } else {
-    ch = NewHash();
-  }
-  if (Getattr(ch,ms)) goto check_exit;    /* Already checked this type */
-  Setattr(ch, ms, "1");
   mh = Getattr(r_mangled,ms);
   if (mh) {
     Iterator ki;
     ki = First(mh);
     while (ki.key) {
-      Hash *rh;
-      Setattr(ch,ki.key,"1");
       clientdata = Getattr(r_clientdata,ki.key);
-      if (clientdata) goto check_exit;
-      rh = Getattr(r_resolved,ki.key);
-      if (rh) {
-	Iterator rk;
-	rk = First(rh);
-	while (rk.key) {
-	  clientdata = SwigType_clientdata_collect(rk.key,ch);
-	  if (clientdata) goto check_exit;
-	  rk = Next(rk);
-	}
-      }
+      if (clientdata) break;
       ki = Next(ki);
     }
   }
- check_exit:
-  if (!checked) {
-    Delete(ch);
-  }
   return clientdata;
 }
 
@@ -1671,6 +1647,9 @@ SwigType_emit_type_table(File *f_forward, File *f_table) {
   Printf(stdout,"---conversions---\n");
   Printf(stdout,"%s\n", conversions);
 
+  Printf(stdout,"---r_clientdata---\n");
+  Printf(stdout,"%s\n", r_clientdata);
+
 #endif
   table = NewString("");
   types = NewString("");
@@ -1691,7 +1670,7 @@ SwigType_emit_type_table(File *f_forward, File *f_table) {
     Printf(f_forward,"#define  SWIGTYPE%s swig_types[%d] \n", ki.key, i);
     Printv(types,"static swig_type_info _swigt_", ki.key, "[] = {", NIL);
     
-    cd = SwigType_clientdata_collect(ki.key,0);
+    cd = SwigType_clientdata_collect(ki.key);
     if (!cd) cd = "0";
     lt = Getattr(r_ltype,ki.key);
     rt = SwigType_typedef_resolve_all(lt);