Apply patch 3224663 for Tcl - NULL value fixes and performance improvements for classes with many methods.

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

CHANGES.current

@@ -5,6 +5,15 @@ See the RELEASENOTES file for a summary of changes in each release.
 Version 2.0.3 (in progress)
 ===========================
 
+2011-03-29: wsfulton
+            [Tcl] Apply patch #3224663 from Christian Delbaere.
+            1. Fix when function returns a NULL value, a "NULL" command will be created in the Tcl interpreter
+            and calling this command will cause a segmentation fault. 
+
+            2. Previous implementation searches for class methods using a linear search causing performance issues
+            in wrappers for classes with many member functions. The patch adds a method hash table to classes and
+            changes method name lookup to use the hash table instead of doing a linear search.
+
 2011-03-26: wsfulton
 	    [C#, Java] SF bug #3195112 - fix wrapping of enums that are type char, for example:
               enum { X = 'X'; }

Examples/test-suite/null_pointer.i

@@ -8,5 +8,9 @@
   bool func(A* a) {
     return !a;
   }
+
+  A* getnull() {
+    return 0;
+  }
 }
 

Examples/test-suite/tcl/null_pointer_runme.tcl

@@ -0,0 +1,21 @@
+if [ catch { load ./null_pointer[info sharedlibextension] null_pointer} err_msg ] {
+	puts stderr "Could not load shared object:\n$err_msg"
+}
+
+set a [A]
+if {[func $a] != 0} {
+    puts stderr "null_pointer test 1 failed"
+    exit 1
+}
+
+set null [getnull]
+if {$null != "NULL"} {
+    puts stderr "null_pointer test 2 failed"
+    exit 1
+}
+
+if {[llength [info commands "NULL"]] != 0} {
+    puts stderr "null_pointer test 3 failed"
+    exit 1
+}
+

Lib/tcl/tclapi.swg

@@ -49,6 +49,7 @@ typedef struct swig_class {
   struct swig_class **bases;
   const char              **base_names;
   swig_module_info   *module;
+  Tcl_HashTable       hashtable;
 } swig_class;
 
 typedef struct swig_instance {

Lib/tcl/tclinit.swg

@@ -67,6 +67,28 @@ SWIG_Tcl_InstallConstants(Tcl_Interp *interp, swig_const_info constants[]) {
   }
 }
 
+/* Create fast method lookup tables */
+
+SWIGINTERN void
+SWIG_Tcl_InstallMethodLookupTables(Tcl_Interp *interp) {
+  int i;
+
+  for (i = 0; i < swig_module.size; ++i) {
+    swig_type_info *type = swig_module.type_initial[i];
+    if (type->clientdata) {
+      swig_class* klass = (swig_class*) type->clientdata;
+      Tcl_InitHashTable(&(klass->hashtable), TCL_STRING_KEYS);
+      swig_method* meth = klass->methods;
+      while (meth && meth->name) {
+        int newEntry;
+        Tcl_HashEntry* hashentry = Tcl_CreateHashEntry(&(klass->hashtable), meth->name, &newEntry);
+        Tcl_SetHashValue(hashentry, (ClientData)meth->method);
+        ++meth;
+      }
+    }
+  }
+}
+
 #ifdef __cplusplus
 }
 #endif
@@ -113,6 +135,7 @@ SWIGEXPORT int SWIG_init(Tcl_Interp *interp) {
   }
 
   SWIG_Tcl_InstallConstants(interp, swig_constants);
+  SWIG_Tcl_InstallMethodLookupTables(interp);
 
 %}
 

Lib/tcl/tclrun.swg

@@ -367,19 +367,17 @@ SWIG_Tcl_MethodCommand(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_
     }
     cls_stack_bi[cls_stack_top]++;
 
-    meth = cls->methods;
-    /* Check for methods */
-    while (meth && meth->name) {
-      if (strcmp(meth->name,method) == 0) {
+    Tcl_HashEntry* hashentry = Tcl_FindHashEntry(&(cls->hashtable), method);
+    if (hashentry) {
+        ClientData cd = Tcl_GetHashValue(hashentry);
+        swig_wrapper method_wrapper = (swig_wrapper)cd;
         oldarg = objv[1];
         objv[1] = inst->thisptr;
         Tcl_IncrRefCount(inst->thisptr);
-        rcode = (*meth->method)(clientData,interp,objc,objv);
+        rcode = (method_wrapper)(clientData,interp,objc,objv);
         objv[1] = oldarg;
         Tcl_DecrRefCount(inst->thisptr);
         return rcode;
-      }
-      meth++;
     }
     /* Check class methods for a match */
     if (strcmp(method,"cget") == 0) {
@@ -486,7 +484,7 @@ SWIGRUNTIME Tcl_Obj *
 SWIG_Tcl_NewInstanceObj(Tcl_Interp *interp, void *thisvalue, swig_type_info *type, int flags) {
   Tcl_Obj *robj = SWIG_NewPointerObj(thisvalue, type,0);
   /* Check to see if this pointer belongs to a class or not */
-  if ((type->clientdata) && (interp)) {
+  if (thisvalue && (type->clientdata) && (interp)) {
     Tcl_CmdInfo    ci;
     char          *name;
     name = Tcl_GetStringFromObj(robj,NULL);