Add a whole bunch of chicken runme scripts, and fix the bugs exposed by those scripts

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

SWIG/Examples/test-suite/chicken/Makefile.in

@@ -18,7 +18,7 @@ SO           = @SO@
 include $(srcdir)/../common.mk
 
 # Overridden variables here
-SWIGOPT +=
+SWIGOPT += -nounit
 
 # Rules for the different types of tests
 %.cpptest: 
@@ -41,6 +41,9 @@ SWIGOPT +=
 	$(setup) \
 	($(swig_and_compile_multi_cpp); ) && \
 	$(run_testcase)
+	if [ -f $(srcdir)/$(SCRIPTPREFIX)$*$(PROXYSUFFIX) ]; then ( \
+	  $(MAKE) $*.multiproxy; ) \
+	fi;
 
 # Runs the testcase. A testcase is only run if
 # a file is found which has _runme.scm appended after the testcase name.
@@ -65,6 +68,13 @@ run_testcase = \
 	($(swig_and_compile_c); ) && \
 	$(run_testcase)
 
+%.multiproxy: SWIGOPT += -proxy -noclosuses
+%.multiproxy: SCRIPTSUFFIX = $(PROXYSUFFIX)
+%.multiproxy:
+	echo "Checking testcase $* (with run test) under chicken with -proxy"; \
+	($(swig_and_compile_multi_cpp); ) && \
+	$(run_testcase)
+
 # Clean
 %.clean:
 	

SWIG/Examples/test-suite/chicken/casts_runme.ss

@@ -1,2 +1,2 @@
-(load-library 'casts "casts.so")
+(load "casts.so")
 (include "../schemerunme/casts.scm")

SWIG/Examples/test-suite/chicken/char_constant_runme.ss

@@ -1,2 +1,2 @@
-(load-library 'char_constant "char_constant.so")
+(load "char_constant.so")
 (include "../schemerunme/char_constant.scm")

SWIG/Examples/test-suite/chicken/class_ignore_runme.ss

@@ -1,2 +1,2 @@
-(load-library 'class_ignore "class_ignore.so")
+(load "class_ignore.so")
 (include "../schemerunme/class_ignore.scm")

SWIG/Examples/test-suite/chicken/clientdata_prop_runme_proxy.ss

@@ -0,0 +1,95 @@
+(require 'clientdata_prop_a)
+(require 'clientdata_prop_b)
+
+(define a (make <A>))
+(test-A a)
+(test-tA a)
+(test-t2A a)
+(test-t3A a)
+(fA a)
+
+(define b (make <B>))
+(test-A b)
+(test-tA b)
+(test-t2A b)
+(test-t3A b)
+(test-B b)
+(fA b)
+(fB b)
+
+(define c (make <C>))
+(test-A c)
+(test-tA c)
+(test-t2A c)
+(test-t3A c)
+(test-C c)
+(fA c)
+(fC c)
+
+(define d (make <D>))
+(test-A d)
+(test-tA d)
+(test-t2A d)
+(test-t3A d)
+(test-D d)
+(test-tD d)
+(test-t2D d)
+(fA d)
+(fD d)
+
+;; here are the real tests... if the clientdata is correctly
+;; propegated, new-tA, new-t2A, should all return wrapped proxy's
+;; of class <A>
+
+(define a2 (new-tA))
+(if (not (eq? (class-of a2) <A>))
+  (error "Error 1"))
+(test-A a2)
+(test-tA a2)
+(test-t2A a2)
+(test-t3A a2)
+(fA a2)
+
+(define a3 (new-t2A))
+(if (not (eq? (class-of a3) <A>))
+  (error "Error 2"))
+(test-A a3)
+(test-tA a3)
+(test-t2A a3)
+(test-t3A a3)
+(fA a3)
+
+(define a4 (new-t3A))
+(if (not (eq? (class-of a4) <A>))
+  (error "Error 3"))
+(test-A a4)
+(test-tA a4)
+(test-t2A a4)
+(test-t3A a4)
+(fA a4)
+
+(define d2 (new-tD))
+(if (not (eq? (class-of d2) <D>))
+  (error "Error 4"))
+(test-A d2)
+(test-tA d2)
+(test-t2A d2)
+(test-t3A d2)
+(test-D d2)
+(test-tD d2)
+(fA d2)
+(fD d2)
+
+(define d3 (new-t2D))
+(if (not (eq? (class-of d3) <D>))
+  (error "Error 5"))
+(test-A d3)
+(test-tA d3)
+(test-t2A d3)
+(test-t3A d3)
+(test-D d3)
+(test-tD d3)
+(fA d3)
+(fD d3)
+
+(exit 0)

SWIG/Examples/test-suite/chicken/constover_runme.ss

@@ -1,2 +1,2 @@
-(load-library 'constover "constover.so")
+(load "constover.so")
 (include "../schemerunme/constover.scm")

SWIG/Examples/test-suite/chicken/contract_runme.ss

@@ -1,3 +1,3 @@
-(load-library 'contract "contract.so")
+(load "contract.so")
 (include "testsuite.ss")
 (include "../schemerunme/contract.scm")

SWIG/Examples/test-suite/chicken/cpp_basic_runme_proxy.ss

@@ -0,0 +1,51 @@
+(require 'cpp_basic)
+
+(define-macro (check test)
+  `(if (not ,test) (error "Error in test " ',test)))
+
+(define f (make <Foo> 4))
+(check (= (slot-ref f 'num) 4))
+(slot-set! f 'num -17)
+(check (= (slot-ref f 'num) -17))
+
+(define b (make <Bar>))
+
+(slot-set! b 'fptr f)
+(check (= (slot-ref (slot-ref b 'fptr) 'num) -17))
+(check (= (test b -3 (slot-ref b 'fptr)) -5))
+(slot-set! f 'num 12)
+(check (= (slot-ref (slot-ref b 'fptr) 'num) 12))
+
+(check (= (slot-ref (slot-ref b 'fref) 'num) -4))
+(check (= (test b 12 (slot-ref b 'fref)) 23))
+;; references don't take ownership, so if we didn't define this here it might get garbage collected
+(define f2 (make <Foo> 23))
+(slot-set! b 'fref f2)
+(check (= (slot-ref (slot-ref b 'fref) 'num) 23))
+(check (= (test b -3 (slot-ref b 'fref)) 35))
+
+(check (= (slot-ref (slot-ref b 'fval) 'num) 15))
+(check (= (test b 3 (slot-ref b 'fval)) 33))
+(slot-set! b 'fval (make <Foo> -15))
+(check (= (slot-ref (slot-ref b 'fval) 'num) -15))
+(check (= (test b 3 (slot-ref b 'fval)) -27))
+
+(define f3 (testFoo b 12 (slot-ref b 'fref)))
+(check (= (slot-ref f3 'num) 32))
+
+;; now test global
+(define f4 (make <Foo> 6))
+(Bar-global-fptr f4)
+(check (= (slot-ref (Bar-global-fptr) 'num) 6))
+(slot-set! f4 'num 8)
+(check (= (slot-ref (Bar-global-fptr) 'num) 8))
+
+(check (= (slot-ref (Bar-global-fref) 'num) 23))
+(Bar-global-fref (make <Foo> -7))
+(check (= (slot-ref (Bar-global-fref) 'num) -7))
+
+(check (= (slot-ref (Bar-global-fval) 'num) 3))
+(Bar-global-fval (make <Foo> -34))
+(check (= (slot-ref (Bar-global-fval) 'num) -34))
+
+(exit 0)

SWIG/Examples/test-suite/chicken/cpp_enum_runme.ss

@@ -1,2 +1,2 @@
-(load-library 'cpp-enum "cpp_enum.so")
+(load "cpp_enum.so")
 (include "../schemerunme/cpp_enum.scm")

SWIG/Examples/test-suite/chicken/cpp_namespace_runme.ss

@@ -1,2 +1,2 @@
-(load-library 'cpp_namespace "cpp_namespace.so")
+(load "cpp_namespace.so")
 (include "../schemerunme/cpp_namespace.scm")

SWIG/Examples/test-suite/chicken/dynamic_cast_runme.ss

@@ -1,2 +1,2 @@
-(load-library 'dynamic_cast "dynamic_cast.so")
+(load "dynamic_cast.so")
 (include "../schemerunme/dynamic_cast.scm")

SWIG/Examples/test-suite/chicken/global_vars_runme.ss

@@ -0,0 +1,2 @@
+(require 'global_vars)
+(load "../schemerunme/global_vars.scm")

SWIG/Examples/test-suite/chicken/global_vars_runme_proxy.ss

@@ -0,0 +1,2 @@
+(require 'global_vars)
+(load "../schemerunme/global_vars_proxy.scm")

SWIG/Examples/test-suite/chicken/import_nomodule_runme.ss

@@ -1,2 +1,2 @@
-(load-library 'import_nomodule "import_nomodule.so")
+(load "import_nomodule.so")
 (include "../schemerunme/import_nomodule.scm")

SWIG/Examples/test-suite/chicken/imports_runme.ss

@@ -1,3 +1,3 @@
-(load-library 'imports_a "imports_a.so")
-(load-library 'imports_b "imports_b.so")
+(load "imports_a.so")
+(load "imports_b.so")
 (include "../schemerunme/imports.scm")

SWIG/Examples/test-suite/chicken/inherit_missing_runme.ss

@@ -1,2 +1,2 @@
-(load-library 'inherit_missing "inherit_missing.so")
+(load "inherit_missing.so")
 (include "../schemerunme/inherit_missing.scm")

SWIG/Examples/test-suite/chicken/li_std_string_runme.ss

@@ -1,2 +1,2 @@
-(load-library 'li-std-string "li_std_string.so")
+(load "li_std_string.so")
 (include "../schemerunme/li_std_string.scm")

SWIG/Examples/test-suite/chicken/li_std_string_runme_proxy.ss

@@ -0,0 +1,48 @@
+(load "li_std_string.so")
+
+(define x "hello")
+
+(if (not (string=? (test-value x) x))
+  (begin (error "Error 1") (exit 1)))
+
+(if (not (string=? (test-const-reference x) x))
+  (begin (error "Error 2") (exit 1)))
+
+(define y (test-pointer-out))
+(test-pointer y)
+(define z (test-const-pointer-out))
+(test-const-pointer z)
+
+(define a (test-reference-out))
+(test-reference a)
+
+;; test global variables
+(GlobalString "whee")
+(if (not (string=? (GlobalString) "whee"))
+  (error "Error 3"))
+(if (not (string=? (GlobalString2) "global string 2"))
+  (error "Error 4"))
+
+(define struct (make <Structure>))
+
+;; MemberString should be a wrapped class
+(define scl (slot-ref struct 'MemberString))
+(if (not (string=? (slot-ref scl 'str) ""))
+  (error "Error 4.5"))
+(slot-set! scl 'str "and how")
+(if (not (string=? (slot-ref (slot-ref struct 'MemberString) 'str) "and how"))
+  (error "Error 5"))
+(if (not (string=? (slot-ref struct 'MemberString2) "member string 2"))
+  (error "Error 6"))
+(Structure-StaticMemberString "static str")
+(if (not (string=? (Structure-StaticMemberString) "static str"))
+  (error "Error 7"))
+(if (not (string=? (Structure-StaticMemberString2) "static member string 2"))
+  (error "Error 8"))
+
+;(if (not (string=? (Structure-ConstMemberString-get struct) "const member string"))
+;  (error "Error 9"))
+(if (not (string=? (Structure-ConstStaticMemberString) "const static member string"))
+  (error "Error 10"))
+
+(exit 0)

SWIG/Examples/test-suite/chicken/li_typemaps_runme.ss

@@ -0,0 +1,2 @@
+(require 'li_typemaps)
+(load "../schemerunme/li_typemaps.scm")

SWIG/Examples/test-suite/chicken/li_typemaps_runme_proxy.ss

@@ -0,0 +1,2 @@
+(require 'li_typemaps)
+(load "../schemerunme/li_typemaps_proxy.scm")

SWIG/Examples/test-suite/chicken/list_vector_runme.ss

@@ -1,2 +1,2 @@
-(load-library 'list_vector "list_vector.so")
+(load "list_vector.so")
 (include "../schemerunme/list_vector.scm")

SWIG/Examples/test-suite/chicken/multiple_inheritance_runme_proxy.ss

@@ -0,0 +1,2 @@
+(require 'multiple_inheritance)
+(load "../schemerunme/multiple_inheritance_proxy.scm")

SWIG/Examples/test-suite/chicken/multivalue_runme.ss

@@ -1,4 +1,4 @@
 ;; this doesn't work yet :(
-(load-library 'multivalue "multivalue.so")
+(load "multivalue.so")
 (include "../schemerunme/multivalue.scm")
 (exit 0)

SWIG/Examples/test-suite/chicken/name_runme.ss

@@ -1,2 +1,2 @@
-(load-library 'name "name.so")
+(load "name.so")
 (include "../schemerunme/name.scm")

SWIG/Examples/test-suite/chicken/newobject1_runme_proxy.ss

@@ -0,0 +1,30 @@
+(require 'newobject1)
+
+(define-macro (check-count val)
+  `(if (not (= (Foo-fooCount) ,val)) (error "Error checking val " ,val " != " ,(Foo-fooCount))))
+
+(define f (Foo-makeFoo))
+
+(check-count 1)
+
+(define f2 (makeMore f))
+
+(check-count 2)
+
+(set! f #f)
+(gc #t)
+
+(check-count 1)
+
+(define f3 (makeMore f2))
+
+(check-count 2)
+
+(set! f3 #f)
+(set! f2 #f)
+
+(gc #t)
+
+(check-count 0)
+
+(exit 0)

SWIG/Examples/test-suite/chicken/newobject2_runme.ss

@@ -1,4 +1,4 @@
-(load-library 'newobject2 "newobject2.so")
+(load "newobject2.so")
 
 (define f (new-Foo))
 

SWIG/Examples/test-suite/chicken/newobject2_runme_proxy.ss

@@ -1,4 +1,4 @@
-(load-library 'newobject2 "newobject2.so")
+(load "newobject2.so")
 
 (define f (make <Foo>))
 

SWIG/Examples/test-suite/chicken/overload_complicated_runme.ss

@@ -1,2 +1,2 @@
-(load-library 'overload_complicated "overload_complicated.so")
+(load "overload_complicated.so")
 (include "../schemerunme/overload_complicated.scm")

SWIG/Examples/test-suite/chicken/overload_copy_runme.ss

@@ -1,2 +1,2 @@
-(load-library 'overload_copy "overload_copy.so")
+(load "overload_copy.so")
 (include "../schemerunme/overload_copy.scm")

SWIG/Examples/test-suite/chicken/overload_copy_runme_proxy.ss

@@ -1,6 +1,4 @@
-(require 'tinyclos)
-(load "../../../Lib/chicken/multi-generic.scm")
-(load-library 'overload-copy "./overload_copy.so")
+(load "./overload_copy.so")
 
 (define f (make <Foo>))
 (define g (make <Foo> f))

SWIG/Examples/test-suite/chicken/overload_extend_runme.ss

@@ -1,2 +1,2 @@
-(load-library 'overload_extend "overload_extend.so")
+(load "overload_extend.so")
 (include "../schemerunme/overload_extend.scm")

SWIG/Examples/test-suite/chicken/overload_extend_runme_proxy.ss

@@ -1,6 +1,4 @@
-(require 'tinyclos)
-(load "../../../Lib/chicken/multi-generic.scm")
-(load-library 'overload-extend "./overload_extend.so")
+(load "./overload_extend.so")
 
 (define f (make <Foo>))
 

SWIG/Examples/test-suite/chicken/overload_simple_runme.ss

@@ -1,2 +1,2 @@
-(load-library 'overload_simple "overload_simple.so")
+(load "overload_simple.so")
 (include "../schemerunme/overload_simple.scm")

SWIG/Examples/test-suite/chicken/overload_simple_runme_proxy.ss

@@ -1,6 +1,4 @@
-(require 'tinyclos)
-(load "../../../Lib/chicken/multi-generic.scm")
-(load-library 'overload_simple "overload_simple.so")
+(load "overload_simple.so")
 
 (define-macro (check test)
   `(if (not ,test) (error ',test)))

SWIG/Examples/test-suite/chicken/overload_subtype_runme.ss

@@ -1,2 +1,2 @@
-(load-library 'overload_subtype "overload_subtype.so")
+(load "overload_subtype.so")
 (include "../schemerunme/overload_subtype.scm")

SWIG/Examples/test-suite/chicken/overload_subtype_runme_proxy.ss

@@ -1,4 +1,4 @@
-(load-library 'overload-subtype "./overload_subtype.so")
+(load "./overload_subtype.so")
 
 (define f (make <Foo>))
 (define b (make <Bar>))

SWIG/Examples/test-suite/chicken/pointer_in_out_runme.ss

@@ -1,2 +1,2 @@
-(load-library 'pointer_in_out "pointer_in_out.so")
+(load "pointer_in_out.so")
 (include "../schemerunme/pointer_in_out.scm")

SWIG/Examples/test-suite/chicken/reference_global_vars_runme.ss

@@ -1,2 +1,2 @@
-(load-library 'reference_global_vars "reference_global_vars.so")
+(load "reference_global_vars.so")
 (include "../schemerunme/reference_global_vars.scm")

SWIG/Examples/test-suite/chicken/throw_exception_runme.ss

@@ -1,4 +1,4 @@
-(load-library 'throw-exception "throw_exception.so")
+(load "throw_exception.so")
 
 (define-macro (check-throw expr check)
  `(if (handle-exceptions exvar (if ,check #f (begin (print "Error executing: " ',expr " " exvar) (exit 1))) ,expr #t)

SWIG/Examples/test-suite/chicken/typedef_inherit_runme.ss

@@ -1,2 +1,2 @@
-(load-library 'typedef_inherit "typedef_inherit.so")
+(load "typedef_inherit.so")
 (include "../schemerunme/typedef_inherit.scm")

SWIG/Examples/test-suite/chicken/typename_runme.ss

@@ -1,2 +1,2 @@
-(load-library 'typename "typename.so")
+(load "typename.so")
 (include "../schemerunme/typename.scm")

SWIG/Examples/test-suite/chicken/unions_runme.ss

@@ -1,2 +1,2 @@
-(load-library 'unions "unions.so")
+(load "unions.so")
 (include "../schemerunme/unions.scm")

SWIG/Examples/test-suite/chicken/unions_runme_proxy.ss

@@ -0,0 +1,2 @@
+(load "unions.so")
+(include "../schemerunme/unions_proxy.scm")