The great merge

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

SWIG/Examples/test-suite/tcl/.cvsignore

@@ -0,0 +1,3 @@
+*wrap*
+*.so
+*.dll

SWIG/Examples/test-suite/tcl/Makefile

@@ -0,0 +1,41 @@
+#######################################################################
+# $Header$
+# Makefile for tcl test-suite
+#######################################################################
+
+LANGUAGE   = tcl
+SCRIPTSUFFIX = _runme.tcl 
+
+include ../common.mk
+
+# Overridden variables here
+
+# Rules for the different types of tests
+%.cpptest: 
+	$(setup) \
+	($(swig_and_compile_cpp); ); \
+	$(run_testcase)
+
+%.ctest:
+	$(setup) \
+	($(swig_and_compile_c); ); \
+	$(run_testcase)
+
+%.multicpptest: 
+	$(setup) \
+	($(swig_and_compile_multi_cpp); ); \
+	$(run_testcase)
+
+# Runs the testcase. A testcase is only run if
+# a file is found which has _runme.tcl appended after the testcase name.
+run_testcase = \
+	if [ -f $*\_runme.tcl ]; then ( \
+	  env LD_LIBRARY_PATH=$(DYNAMIC_LIB_PATH):$$LD_LIBRARY_PATH tclsh $*\_runme.tcl;) \
+	fi;
+
+# Clean
+%.clean:
+	
+
+clean:
+	$(MAKE) -f $(TOP)/Makefile tcl_clean

SWIG/Examples/test-suite/tcl/README

@@ -0,0 +1,4 @@
+See ../README for common README file.
+
+Any testcases which have _runme.tcl appended after the testcase name will be detected and run.
+

SWIG/Examples/test-suite/tcl/import_nomodule_runme.tcl

@@ -0,0 +1,10 @@
+
+if { [ string match $tcl_platform(platform) "windows" ] == 1 } {
+    if [ catch { load ./import_nomodule.dll import_nomodule} err_msg ] {
+        puts stderr "Could not load dll:\n$err_msg"
+    }
+} else {
+    if [ catch { load ./import_nomodule.so import_nomodule} err_msg ] {
+        puts stderr "Could not load shared object:\n$err_msg"
+    }
+}

SWIG/Examples/test-suite/tcl/imports_runme.tcl

@@ -0,0 +1,26 @@
+
+# This is the imports runtime testcase. 
+
+if { [ string match $tcl_platform(os) Windows* ] == 1 } {
+    if [ catch { load ./imports_a.dll imports_a} err_msg ] {    ;# Windows
+        puts stderr "Could not load dll:\n$err_msg"
+        exit 1
+    }
+    if [ catch { load ./imports_b.dll imports_b} err_msg ] {    ;# Windows
+        puts stderr "Could not load dll:\n$err_msg"
+        exit 1
+    }
+} else {
+    if [ catch { load ./imports_a.so imports_a} err_msg ] {
+        puts stderr "Could not load shared object:\n$err_msg"
+        exit 1
+    }
+    if [ catch { load ./imports_b.so imports_b} err_msg ] {
+        puts stderr "Could not load shared object:\n$err_msg"
+	exit 1
+    }
+}
+
+set x [new_B]
+A_hello $x
+

SWIG/Examples/test-suite/tcl/overload_copy_runme.tcl

@@ -0,0 +1,18 @@
+
+if { [ string match $tcl_platform(platform) "windows" ] == 1 } {
+    if [ catch { load ./overload_copy.dll overload_copy} err_msg ] {
+        puts stderr "Could not load dll:\n$err_msg"
+    }
+} else {
+    if [ catch { load ./overload_copy.so overload_copy} err_msg ] {
+        puts stderr "Could not load shared object:\n$err_msg"
+    }
+}
+
+Foo f
+Foo g [f cget -this]
+
+
+
+
+

SWIG/Examples/test-suite/tcl/overload_simple_runme.tcl

@@ -0,0 +1,172 @@
+
+if { [ string match $tcl_platform(platform) "windows" ] == 1 } {
+    if [ catch { load ./overload_simple.dll overload_simple} err_msg ] {
+        puts stderr "Could not load dll:\n$err_msg"
+    }
+} else {
+    if [ catch { load ./overload_simple.so overload_simple} err_msg ] {
+        puts stderr "Could not load shared object:\n$err_msg"
+    }
+}
+
+set f [new_Foo]
+set b [new_Bar]
+set v [malloc_void 32]
+
+set x [foo 3]
+if {$x != "foo:int"} {
+   puts stderr "foo(int) test failed"
+   exit 1
+}
+
+set x [foo 3.4]
+if {$x != "foo:double"} {
+   puts stderr "foo(double) test failed"
+   exit 1
+}
+
+set x [foo hello]
+if {$x != "foo:char *"} {
+   puts stderr "foo(char *) test failed"
+   exit 1
+}
+
+set x [foo $f]
+if {$x != "foo:Foo *"} {
+   puts stderr "foo(Foo *) test failed"
+   exit 1
+}
+
+set x [foo $b]
+if {$x != "foo:Bar *"} {
+   puts stderr "foo(Bar *) test failed"
+   exit 1
+}
+
+set x [foo $v]
+if {$x != "foo:void *"} {
+   puts stderr "foo(void *) test failed"
+   exit 1
+}
+
+Spam s
+
+set x [s foo 3]
+if {$x != "foo:int"} {
+   puts stderr "Spam::foo(int) test failed"
+   exit 1
+}
+
+set x [s foo 3.4]
+if {$x != "foo:double"} {
+   puts stderr "Spam::foo(double) test failed"
+   exit 1
+}
+
+set x [s foo hello]
+if {$x != "foo:char *"} {
+   puts stderr "Spam::foo(char *) test failed"
+   exit 1
+}
+
+set x [s foo $f]
+if {$x != "foo:Foo *"} {
+   puts stderr "Spam::foo(Foo *) test failed"
+   exit 1
+}
+
+set x [s foo $b]
+if {$x != "foo:Bar *"} {
+   puts stderr "Spam::foo(Bar *) test failed"
+   exit 1
+}
+
+set x [s foo $v]
+if {$x != "foo:void *"} {
+   puts stderr "Spam::foo(void *) test failed"
+   exit 1
+}
+
+
+set x [Spam_bar 3]
+if {$x != "bar:int"} {
+   puts stderr "Spam::bar(int) test failed"
+   exit 1
+}
+
+set x [Spam_bar 3.4]
+if {$x != "bar:double"} {
+   puts stderr "Spam::bar(double) test failed"
+   exit 1
+}
+
+set x [Spam_bar hello]
+if {$x != "bar:char *"} {
+   puts stderr "Spam::bar(char *) test failed"
+   exit 1
+}
+
+set x [Spam_bar $f]
+if {$x != "bar:Foo *"} {
+   puts stderr "Spam::bar(Foo *) test failed"
+   exit 1
+}
+
+set x [Spam_bar $b]
+if {$x != "bar:Bar *"} {
+   puts stderr "Spam::bar(Bar *) test failed"
+   exit 1
+}
+
+set x [Spam_bar $v]
+if {$x != "bar:void *"} {
+   puts stderr "Spam::bar(void *) test failed"
+   exit 1
+}
+
+Spam s
+set x [s cget -type]
+if {$x != "none"} {
+    puts stderr "Spam() test failed"
+}
+
+Spam s 3
+set x [s cget -type]
+if {$x != "int"} {
+    puts stderr "Spam(int) test failed"
+}
+
+Spam s 3.4
+set x [s cget -type]
+if {$x != "double"} {
+    puts stderr "Spam(double) test failed"
+}
+
+Spam s hello
+set x [s cget -type]
+if {$x != "char *"} {
+    puts stderr "Spam(char *) test failed"
+}
+
+Spam s $f
+set x [s cget -type]
+if {$x != "Foo *"} {
+    puts stderr "Spam(Foo *) test failed"
+}
+
+Spam s $b
+set x [s cget -type]
+if {$x != "Bar *"} {
+    puts stderr "Spam(Bar *) test failed"
+}
+
+Spam s $v
+set x [s cget -type]
+if {$x != "void *"} {
+    puts stderr "Spam(void *) test failed"
+}
+
+
+
+
+

SWIG/Examples/test-suite/tcl/primitive_ref_runme.tcl

@@ -0,0 +1,25 @@
+# Primitive ref testcase.  Tests to make sure references to 
+# primitive types are passed by value
+
+if { [ string match $tcl_platform(platform) "windows" ] == 1 } {
+    if [ catch { load ./primitive_ref.dll primitive_ref} err_msg ] {
+        puts stderr "Could not load dll:\n$err_msg"
+    }
+} else {
+    if [ catch { load ./primitive_ref.so primitive_ref} err_msg ] {
+        puts stderr "Could not load shared object:\n$err_msg"
+    }
+}
+
+if { [ref_int 3] != 3 } { puts stderr "ref_int failed" }
+if { [ref_uint 3] != 3 } { puts stderr "ref_uint failed" }
+if { [ref_short 3] != 3 } { puts stderr "ref_short failed" }
+if { [ref_ushort 3] != 3 } { puts stderr "ref_ushort failed" }
+if { [ref_long 3] != 3 } { puts stderr "ref_long failed" }
+if { [ref_ulong 3] != 3 } { puts stderr "ref_ulong failed" }
+if { [ref_schar 3] != 3 } { puts stderr "ref_schar failed" }
+if { [ref_uchar 3] != 3 } { puts stderr "ref_uchar failed" }
+if { [ref_float 3.5] != 3.5 } { puts stderr "ref_float failed" }
+if { [ref_double 3.5] != 3.5 } { puts stderr "ref_double failed" }
+if { [ref_char x] != "x" } { puts stderr "ref_char failed" }
+

SWIG/Examples/test-suite/tcl/unions_runme.tcl

@@ -0,0 +1,69 @@
+
+# This is the union runtime testcase. It ensures that values within a 
+# union embedded within a struct can be set and read correctly.
+
+if { [ string match $tcl_platform(platform) "windows" ] == 1 } {
+    if [ catch { load ./unions.dll unions} err_msg ] {
+        puts stderr "Could not load dll:\n$err_msg"
+    }
+} else {
+    if [ catch { load ./unions.so unions} err_msg ] {
+        puts stderr "Could not load shared object:\n$err_msg"
+    }
+}
+
+# Create new instances of SmallStruct and BigStruct for later use
+SmallStruct small
+small configure -jill 200
+
+BigStruct big
+big configure -smallstruct [small cget -this]
+big configure -jack 300
+
+# Use SmallStruct then BigStruct to setup EmbeddedUnionTest.
+# Ensure values in EmbeddedUnionTest are set correctly for each.
+EmbeddedUnionTest eut
+
+# First check the SmallStruct in EmbeddedUnionTest
+eut configure -number 1
+
+#eut.uni.small = small
+EmbeddedUnionTest_uni_small_set [EmbeddedUnionTest_uni_get [eut cget -this] ] [small cget -this]
+
+#Jill1 = eut.uni.small.jill
+set Jill1 [SmallStruct_jill_get [EmbeddedUnionTest_uni_small_get [EmbeddedUnionTest_uni_get [eut cget -this] ] ] ]
+if {$Jill1 != 200} {
+    puts stderr "Runtime test1 failed. eut.uni.small.jill=$Jill1"
+    exit 1
+}
+
+set Num1 [eut cget -number]
+if {$Num1 != 1} {
+    puts stderr "Runtime test2 failed. eut.number=$Num1"
+    exit 1
+}
+
+# Secondly check the BigStruct in EmbeddedUnionTest
+eut configure -number 2
+#eut.uni.big = big
+EmbeddedUnionTest_uni_big_set [EmbeddedUnionTest_uni_get [eut cget -this] ] [big cget -this]
+#Jack1 = eut.uni.big.jack
+set Jack1 [BigStruct_jack_get [EmbeddedUnionTest_uni_big_get [EmbeddedUnionTest_uni_get [eut cget -this] ] ] ]
+if {$Jack1 != 300} {
+    puts stderr "Runtime test3 failed. eut.uni.big.jack=$Jack1"
+    exit 1
+}
+
+#Jill2 = eut.uni.big.smallstruct.jill
+set Jill2 [SmallStruct_jill_get [BigStruct_smallstruct_get [EmbeddedUnionTest_uni_big_get [EmbeddedUnionTest_uni_get [eut cget -this] ] ] ] ]
+if {$Jill2 != 200} {
+    puts stderr "Runtime test4 failed. eut.uni.big.smallstruct.jill=$Jill2"
+    exit 1
+}
+
+set Num2 [eut cget -number]
+if {$Num2 != 2} {
+    puts stderr "Runtime test5 failed. eut.number=$Num2"
+    exit 1
+}
+