[Tcl] Prevent SWIG_Tcl_ConvertPtr from calling the unknown proc.

Add Examples/tcl/std_vector/ which this change fixes.  Patch
is from "Cliff C" in SF#1809819.


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

CHANGES.current

@@ -1,6 +1,11 @@
 Version 1.3.32 (in progress)
 ============================
 
+10/15/2007: olly
+	    [Tcl] Prevent SWIG_Tcl_ConvertPtr from calling the unknown proc.
+	    Add Examples/tcl/std_vector/ which this change fixes.  Patch
+	    is from "Cliff C" in SF#1809819.
+
 10/12/2007: wuzzeb
 	    Added a testsuite entry for Bug #1735931
 

Examples/tcl/check.list

@@ -11,5 +11,6 @@ operator
 pointer
 reference
 simple
+std_vector
 value
 variables

Examples/tcl/std_vector/Makefile

@@ -0,0 +1,20 @@
+TOP        = ../..
+SWIG       = $(TOP)/../preinst-swig
+CXXSRCS    = 
+TARGET     = my_tclsh
+DLTARGET   = example
+INTERFACE  = example.i
+LIBS       = -lm
+
+all::
+	$(MAKE) -f $(TOP)/Makefile CXXSRCS='$(CXXSRCS)' SWIG='$(SWIG)' \
+	TARGET='$(DLTARGET)' INTERFACE='$(INTERFACE)' tcl_cpp
+
+static::
+	$(MAKE) -f $(TOP)/Makefile CXXSRCS='$(CXXSRCS)' SWIG='$(SWIG)' \
+	TARGET='$(TARGET)' INTERFACE='$(INTERFACE)' tclsh_cpp_static
+
+clean::
+	$(MAKE) -f $(TOP)/Makefile tcl_clean
+
+check: all

Examples/tcl/std_vector/example.h

@@ -0,0 +1,25 @@
+/* File : example.h */
+
+#include <vector>
+#include <algorithm>
+#include <functional>
+#include <numeric>
+
+double average(std::vector<int> v) {
+    return std::accumulate(v.begin(),v.end(),0.0)/v.size();
+}
+
+std::vector<double> half(const std::vector<double>& v) {
+    std::vector<double> w(v);
+    for (unsigned int i=0; i<w.size(); i++)
+        w[i] /= 2.0;
+    return w;
+}
+
+void halve_in_place(std::vector<double>& v) {
+    // would you believe this is the same as the above?
+    std::transform(v.begin(),v.end(),v.begin(),
+                   std::bind2nd(std::divides<double>(),2.0));
+}
+
+

Examples/tcl/std_vector/example.i

@@ -0,0 +1,17 @@
+/* File : example.i */
+%module example
+
+%{
+#include "example.h"
+%}
+
+%include stl.i
+/* instantiate the required template specializations */
+namespace std {
+    %template(IntVector)    vector<int>;
+    %template(DoubleVector) vector<double>;
+}
+
+/* Let's just grab the original header file here */
+%include "example.h"
+

Examples/tcl/std_vector/runme.tcl

@@ -0,0 +1,40 @@
+# file: runme.tcl
+
+catch { load ./example[info sharedlibextension] example}
+
+# Exercise IntVector
+
+set iv [IntVector]
+$iv push 1
+$iv push 3
+$iv push 5
+
+puts "IntVector size:      [$iv size]   (should be 3)"
+puts "IntVector average:   [average $iv] (should be 3.0)"
+puts "IntVector pop:       [$iv pop]   (should be 5)"
+puts "IntVector pop:       [$iv pop]   (should be 3)"
+puts "IntVector get 0:     [$iv get 0]   (should be 1)"
+puts ""
+
+# Exercise DoubleVector
+
+set dv [DoubleVector]
+$dv push 2 
+$dv push 4
+$dv push 6
+ 
+puts "DoubleVector size:   [$dv size]           (should be 3)"
+puts "DoubleVector data:   [$dv get 0] [$dv get 1] [$dv get 2] (should be 2.0 4.0 6.0)"
+halve_in_place $dv
+puts "DoubleVector halved: [$dv get 0] [$dv get 1] [$dv get 2] (should be 1.0 2.0 3.0)"
+puts ""
+
+# Complain if unknown is called
+rename unknown unknown_orig
+proc unknown {args} {
+  puts "ERROR: unknown called with: $args"
+  uplevel 1 unknown_orig $args
+}
+
+puts "average \"1 2 3\": [average [list 1 2 3]]"
+

Lib/tcl/tclrun.swg

@@ -125,15 +125,38 @@ SWIG_Tcl_ConvertPtrFromString(Tcl_Interp *interp, const char *c, void **ptr, swi
   while (*c != '_') {
     *ptr = (void *) 0;
     if (strcmp(c,"NULL") == 0) return SWIG_OK;
+
+    /* Empty string: not a pointer */
+    if (*c == 0) return SWIG_ERROR; 
+
     /* Hmmm. It could be an object name. */
-    if (Tcl_VarEval(interp,c," cget -this", (char *) NULL) == TCL_OK) {
+
+    /* Check if this is a command at all. Prevents <c> cget -this         */
+    /* from being called when c is not a command, firing the unknown proc */
+    if (Tcl_VarEval(interp,"info commands ", c, (char *) NULL) == TCL_OK) {
       Tcl_Obj *result = Tcl_GetObjResult(interp);
-      c = Tcl_GetStringFromObj(result, NULL);
-      continue;
+      if (*(Tcl_GetStringFromObj(result, NULL)) == 0) {
+        /* It's not a command, so it can't be a pointer */
+        Tcl_ResetResult(interp);
+        return SWIG_ERROR;
+      }
+    } else {
+      /* This will only fail if the argument is multiple words. */
+      /* Multiple words are also not commands.                  */
+      Tcl_ResetResult(interp);
+      return SWIG_ERROR;
     }
-    Tcl_ResetResult(interp);
-    return SWIG_ERROR;
+
+    /* Check if this is really a SWIG pointer */
+    if (Tcl_VarEval(interp,c," cget -this", (char *) NULL) != TCL_OK) {
+      Tcl_ResetResult(interp);
+      return SWIG_ERROR;
+    }
+
+    Tcl_Obj *result = Tcl_GetObjResult(interp);
+    c = Tcl_GetStringFromObj(result, NULL);
   }
+
   c++;
   c = SWIG_UnpackData(c,ptr,sizeof(void *));
   if (ty) {