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/chicken/README

@@ -10,5 +10,3 @@ zlib        -- a wrapping of the zlib compression library
 
 You should be able to run make in each of the examples.  By default, a shared
 library will be built.  Run make check to execute the test.
-
-You can uncomment a few lines in the Makefile to build a static test exe.

SWIG/Examples/chicken/class/Makefile

@@ -7,7 +7,7 @@ TARGET      = class
 INCLUDE     =
 SWIGOPT     =
 CFLAGS      = 
-VARIANT     = _csc
+VARIANT     =
 
 # uncomment the following lines to build a static exe (only pick one of the CHICKEN_MAIN lines)
 #CHICKEN_MAIN = test-lowlevel-class.scm

SWIG/Examples/chicken/class/test-lowlevel-class.scm

@@ -64,8 +64,9 @@
 (display "\nGuess I'll clean up now\n")
 
 ;; Note: this invokes the virtual destructor
-(delete-Shape c)
-(delete-Shape s)
+(set! c #f)
+(set! s #f)
+(gc #t)
 
 (set! s 3)
 (display (Shape-nshapes))

SWIG/Examples/chicken/class/test-tinyclos-class.scm

@@ -20,7 +20,7 @@
 ;; ----- Access a static member -----
 
 (display "\nA total of ")
-(display (nshapes))
+(display (Shape-nshapes))
 (display " shapes were created\n")
 
 ;; ----- Member data access -----
@@ -67,9 +67,9 @@
 ;; Note: Invoke the virtual destructors by forcing garbage collection
 (set! c 77)
 (set! s 88)
-;(gc #t)
+(gc #t)
 
-(display (nshapes))
+(display (Shape-nshapes))
 (display " shapes remain\n")
 (display "Goodbye\n")
 

SWIG/Examples/chicken/constants/test-constants.scm

@@ -1,8 +1,6 @@
-;; run with './constants test-constants.scm'
 ;; feel free to uncomment and comment sections
 
-(load-library 'example "constants.so")
-(declare (uses example))
+(load-library 'example "./constants.so")
 
 (display "starting test ... you will see 'finished' if successful.\n")
 (or (= (ICONST) 42) (exit 1))

SWIG/Examples/chicken/multimap/test-multimap.scm

@@ -2,7 +2,6 @@
 ;; feel free to uncomment and comment sections
 
 (load-library 'example "multimap.so")
-(declare (uses example))
 
 (display "(gcd 90 12): ")
 (display (gcd 90 12))

SWIG/Examples/chicken/overload/test-overload.scm

@@ -1,8 +1,6 @@
 ;; This file demonstrates the overloading capabilities of SWIG
 
 (load-library 'example "overload.so")
-(declare (uses example))
-(declare (uses tinyclos))
 
 ;; Low level
 ;; ---------
@@ -40,7 +38,7 @@ Trying TinyCLOS code ...
 (foo 1)
 (foo "some string")
 (define A-FOO (make <Foo>))
-(define ANOTHER-FOO (make <Foo> (slot-ref A-FOO 'swig-this))) ;; copy constructor
+(define ANOTHER-FOO (make <Foo> A-FOO)) ;; copy constructor
 (bar A-FOO 2)
 (bar ANOTHER-FOO "another string" 3)
 

SWIG/Examples/chicken/simple/example.i

@@ -8,6 +8,6 @@
 
 extern double My_variable;
 extern int    fact(int);
-%name(mod) extern int    my_mod(int n, int m);
+%rename(mod) my_mod;
 extern int    my_mod(int n, int m);
 extern char   *get_time();

SWIG/Examples/chicken/simple/test-simple.scm

@@ -1,6 +1,5 @@
 ;; feel free to uncomment and comment sections
 (load-library 'example "simple.so")
-(declare (uses example))
 
 (display "(My-variable): ")
 (display (My-variable))
@@ -14,31 +13,14 @@
 (display (My-variable))
 (display "\n")
 
-(display "(My-variable 'a): ")
-;;(display (My-variable 'a))
-(display "\n")
-
-(display "(My-variable 1.5 'b): ")
-(display (My-variable 1.5 'b))
-(display "\n")
-
 (display "(fact 5): ")
 (display (fact 5))
 (display "\n")
 
-(display "(fact 'a): ")
-;;(display (fact 'a))
-(display "\n")
-
 (display "(mod 75 7): ")
 (display (mod 75 7))
 (display "\n")
 
-(display "(my-mod 75 7): ")
-(display (my-mod 75 7))
-(display "\n")
-
-
 (display "(get-time): ")
 (display (get-time))
 (display "\n")

SWIG/Examples/chicken/zlib/Makefile

@@ -5,27 +5,24 @@ SRCS        =
 CXXSRCS     = 
 TARGET      = zlib
 INCLUDE     =
-SWIGOPT     = -I/usr/include -mixed -prefix zlib
+SWIGOPT     = -I/usr/include
 CFLAGS      = 
 VARIANT     = 
 LIBS        = -lz
-
-# comment out the following two lines to build a dynamic exe
-CHICKEN_MAIN = test-zlib.scm
-VARIANT      = _static
+VARIANT     = _direct
 
 all:: $(TARGET)
 
 $(TARGET): $(INTERFACE) $(SRCS)
 	$(MAKE) -f $(TOP)/Makefile \
-		SRCS='$(SRCS)' CXXSRCS='$(CXXSRCS)' CHICKEN_MAIN='$(CHICKEN_MAIN)' \
+		SRCS='$(SRCS)' CXXSRCS='$(CXXSRCS)' \
 		INCLUDE='$(INCLUDE)' SWIGOPT='$(SWIGOPT)' LIBS='$(LIBS)' TARGET='$(TARGET)' \
 		SWIG='$(SWIG)' INTERFACE='$(INTERFACE)' CHICKENOPTS='$(CHICKENOPTS)' chicken$(VARIANT)
 
 clean::
 	$(MAKE) -f $(TOP)/Makefile chicken_clean
-	rm -f example.scm example-generic.scm example-clos.scm
+	rm -f example.scm
 	rm -f $(TARGET)
 
 check::
-	csi -batch simple.so test-zlib.scm
+	csi test-zlib.scm

SWIG/Examples/chicken/zlib/test-zlib.scm

@@ -1,45 +1,43 @@
-;; run with './zlib test-zlib.scm'
-
-(declare (uses example))
-(declare (uses format))
+(load-library 'example "./zlib.so")
 
 ;; Init zstream
-(define s (zlib:new-z-stream))
-(zlib:z-stream-zalloc-set s #f)
-(zlib:z-stream-zfree-set s #f)
-(zlib:z-stream-opaque-set s #f)
-(zlib:deflate-init s (zlib:z-default-compression))
+(define s (new-z-stream))
+(z-stream-zalloc-set s #f)
+(z-stream-zfree-set s #f)
+(z-stream-opaque-set s #f)
+(deflate-init s (Z-DEFAULT-COMPRESSION))
 
 ;; Deflate something small so we don't need to loop/stream data
 (define in "some pony et jumping et jack et flash et had a jack pony")
 (define out (make-string 1000))
-(format #t "to be compressed: ~A~%to be compressed bytes: ~D~%~%" in (string-length in))
-(zlib:z-stream-next-in-set s in)
-(zlib:z-stream-avail-in-set s (string-length in))
-(zlib:z-stream-next-out-set s out)
-(zlib:z-stream-avail-out-set s (string-length out))
+(printf "to be compressed: ~A~%to be compressed bytes: ~A~%~%" in (string-length in))
+(z-stream-next-in-set s in)
+(z-stream-avail-in-set s (string-length in))
+(z-stream-next-out-set s out)
+(z-stream-avail-out-set s (string-length out))
 (let*
-    ((saved-out (zlib:z-stream-save-next-out s))
-     (ret (zlib:deflate s (zlib:z-finish))))
+    ((saved-out (z-stream-save-next-out s))
+     (ret (deflate s (Z-FINISH))))
   (cond
-   ((= ret (zlib:z-stream-end))
-    (format #t "deflated properly!~%compressed bytes: ~D~%compressed stream: ~S~%" 
-            (zlib:z-stream-total-out-get s) (zlib:z-stream-get-next-chunk s saved-out)))
-   ((= ret (zlib:z-ok))
+   ((= ret (Z-STREAM-END))
+    (printf "deflated properly!~%compressed bytes: ~A~%compressed stream: ~A~%" 
+            (z-stream-total-out-get s) (z-stream-get-next-chunk s saved-out)))
+   ((= ret (Z-OK))
     (display "only partial deflation ... not enough output space\n"))
    (else
-    (format #t "deflate error(~D): ~A ~%" ret (zlib:z-stream-msg-get s)))))
+    (printf "deflate error(~D): ~A ~%" ret (z-stream-msg-get s)))))
 
 ;; Use simple compress routine, and set max output size to 100
-(define c (zlib:compress 100 in))
+(define c (compress 100 in))
 (newline)
 (let
     ((ret (car c))
      (compressed (cadr c)))
   (cond
-   ((= ret (zlib:z-ok))
-    (format #t "compressed properly!~%compressed bytes: ~D~%compressed stream: ~S~%"
+   ((= ret (Z-OK))
+    (printf "compressed properly!~%compressed bytes: ~A~%compressed stream: ~A~%"
             (string-length compressed) compressed))
    (else
-    (format #t "compress error(~D): ~A ~%" ret (zlib:z-error ret)))))
+    (printf "compress error(~D): ~A ~%" ret (z-error ret)))))
 
+(exit 0)

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")

SWIG/Examples/test-suite/common.mk

@@ -96,6 +96,7 @@ CPP_TEST_CASES += \
 	conversion_namespace \
 	conversion_ns_template \
 	cplusplus_throw \
+	cpp_basic \
 	cpp_enum \
 	cpp_namespace \
 	cpp_nodefault \

SWIG/Examples/test-suite/cpp_basic.i

@@ -0,0 +1,52 @@
+/* This is a basic test of proxy classes, used by chicken */
+
+%module cpp_basic
+
+%newobject Bar::testFoo;
+
+%inline %{
+
+class Foo {
+  public:
+    Foo(int a) : num(a) {}
+    int num;
+};
+
+%}
+
+%{
+static Foo init_ref = Foo(-4);
+%}
+
+%inline %{
+class Bar {
+  public:
+    Bar() : fptr(0), fref(init_ref), fval(15) , cint(3) {}
+  
+    Foo *fptr;
+    Foo &fref;
+    Foo fval;
+
+    const int cint;
+    static const int global_cint = -4;
+
+    static Foo *global_fptr;
+    static Foo &global_fref;
+    static Foo global_fval;
+
+    int test(int a, Foo *f) {
+      return a + (f ? f->num : 0) + fval.num;
+    }
+
+    Foo *testFoo(int a, Foo *f) {
+      return new Foo(2 * a + (f ? f->num : 0) + fval.num);
+    }
+};
+
+%}
+
+%{
+Foo *Bar::global_fptr = NULL;
+Foo &Bar::global_fref = init_ref;
+Foo Bar::global_fval = Foo(3);
+%}

SWIG/Examples/test-suite/guile/li_typemaps_runme.scm

@@ -0,0 +1,8 @@
+;;; This is the union runtime testcase. It ensures that values within a
+;;; union embedded within a struct can be set and read correctly.
+
+;; The SWIG modules have "passive" Linkage, i.e., they don't generate
+;; Guile modules (namespaces) but simply put all the bindings into the
+;; current module.  That's enough for such a simple test.
+(dynamic-call "scm_init_li_typemaps_module" (dynamic-link "./libli_typemaps.so"))
+(load "../schemerunme/li_typemaps.scm")

SWIG/Examples/test-suite/li_typemaps.i

@@ -3,8 +3,11 @@
 %include "typemaps.i"
 
 %apply int &INOUT { int &INOUT2 };
+%newobject out_foo;
 %inline %{
 
+struct Foo { int a; };
+
 bool in_bool(bool *INPUT) { return *INPUT; }
 int in_int(int *INPUT) { return *INPUT; }
 long in_long(long *INPUT) { return *INPUT; }
@@ -47,6 +50,14 @@ void out_double(double x, double *OUTPUT) {  *OUTPUT = x; }
 void out_longlong(long long x, long long *OUTPUT) {  *OUTPUT = x; }
 void out_ulonglong(unsigned long long x, unsigned long long *OUTPUT) {  *OUTPUT = x; }
 
+/* Tests a returning a wrapped pointer and an output argument */
+struct Foo *out_foo(int a, int *OUTPUT) {
+  struct Foo *f = new struct Foo();
+  f->a = a;
+  *OUTPUT = a * 2;
+  return f;
+}
+
 void outr_bool(bool x, bool &OUTPUT) {  OUTPUT = x; }
 void outr_int(int x, int &OUTPUT) {  OUTPUT = x; }
 void outr_short(short x, short &OUTPUT) {  OUTPUT = x; }

SWIG/Examples/test-suite/schemerunme/global_vars.scm

@@ -0,0 +1,31 @@
+(define-macro (check test)
+  `(if (not ,test) (error "Error in test" ',test)))
+
+(b "hello")
+(check (string=? (b) "hello"))
+
+(define sa (new-A))
+(A-x-set sa 5)
+(a sa)
+(check (= (A-x-get (a)) 5))
+
+(ap sa)
+(check (= (A-x-get (ap)) 5))
+(A-x-set sa 10)
+(check (= (A-x-get (ap)) 10))
+
+(define sa2 (new-A))
+(A-x-set sa2 -4)
+(cap sa2)
+(check (= (A-x-get (cap)) -4))
+(A-x-set sa2 -7)
+(check (= (A-x-get (cap)) -7))
+
+(check (= (A-x-get (ar)) 5))
+(ar sa2)
+(check (= (A-x-get (ar)) -7))
+
+(x 4)
+(check (= (x) 4))
+
+(exit 0)

SWIG/Examples/test-suite/schemerunme/global_vars_proxy.scm

@@ -0,0 +1,31 @@
+(define-macro (check test)
+  `(if (not ,test) (error "Error in test" ',test)))
+
+(b "hello")
+(check (string=? (b) "hello"))
+
+(define sa (make <A>))
+(slot-set! sa 'x 5)
+(a sa)
+(check (= (slot-ref (a) 'x) 5))
+
+(ap sa)
+(check (= (slot-ref (ap) 'x) 5))
+(slot-set! sa 'x 10)
+(check (= (slot-ref (ap) 'x) 10))
+
+(define sa2 (make <A>))
+(slot-set! sa2 'x -4)
+(cap sa2)
+(check (= (slot-ref (cap) 'x) -4))
+(slot-set! sa2 'x -7)
+(check (= (slot-ref (cap) 'x) -7))
+
+(check (= (slot-ref (ar) 'x) 5))
+(ar sa2)
+(check (= (slot-ref (ar) 'x) -7))
+
+(x 4)
+(check (= (x) 4))
+
+(exit 0)

SWIG/Examples/test-suite/schemerunme/li_std_string.scm

@@ -14,4 +14,33 @@
 (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 (new-Structure))
+
+;; MemberString should be a wrapped class
+(define scl (Structure-MemberString-get struct))
+(if (not (string=? (std-string-str-get scl) ""))
+  (error "Error 4.5"))
+(std-string-str-set scl "and how")
+(if (not (string=? (std-string-str-get (Structure-MemberString-get struct)) "and how"))
+  (error "Error 5"))
+(if (not (string=? (Structure-MemberString2-get struct) "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/schemerunme/li_typemaps.scm

@@ -0,0 +1,34 @@
+(define-macro (check func val test)
+  (cons 'begin
+    (map
+      (lambda (x) 
+        `(if (not (,test (,(string->symbol (string-append x func)) ,val) ,val))
+           (error ,(string-append "Error in test " x func))))
+      (list "in-" "inr-" "out-" "outr-" "inout-" "inoutr-"))))
+
+(define (=~ a b)
+  (< (abs (- a b)) 1e-5))
+                      
+(check "bool" #t and)
+(check "int" -2 =)
+(check "long" -32 =)
+(check "short" -15 =)
+(check "uint" 75 =)
+(check "ushort" 123 =)
+(check "ulong" 462 =)
+;(check "uchar" 16 =)
+;(check "schar" -53 =)
+(check "float" 4.3 =~)
+(check "double" -175.42 =~)
+;(check "longlong" 1634 =)
+;(check "ulonglong" 6432 =)
+
+(let ((lst (inoutr-int2 3 -2)))
+  (if (not (and (= (car lst) 3) (= (cadr lst) -2)))
+    (error "Error in inoutr-int2")))
+
+(let ((lst (out-foo 4)))
+  (if (not (and (= (Foo-a-get (car lst)) 4) (= (cadr lst) 8)))
+    (error "Error in out-foo")))
+
+(exit 0)

SWIG/Examples/test-suite/schemerunme/li_typemaps_proxy.scm

@@ -0,0 +1,34 @@
+(define-macro (check func val test)
+  (cons 'begin
+    (map
+      (lambda (x) 
+        `(if (not (,test (,(string->symbol (string-append x func)) ,val) ,val))
+           (error ,(string-append "Error in test " x func))))
+      (list "in-" "inr-" "out-" "outr-" "inout-" "inoutr-"))))
+
+(define (=~ a b)
+  (< (abs (- a b)) 1e-5))
+                      
+(check "bool" #t and)
+(check "int" -2 =)
+(check "long" -32 =)
+(check "short" -15 =)
+(check "uint" 75 =)
+(check "ushort" 123 =)
+(check "ulong" 462 =)
+;(check "uchar" 16 =)
+;(check "schar" -53 =)
+(check "float" 4.3 =~)
+(check "double" -175.42 =~)
+(check "longlong" 1634 =)
+(check "ulonglong" 6432 =)
+
+(let ((lst (inoutr-int2 3 -2)))
+  (if (not (and (= (car lst) 3) (= (cadr lst) -2)))
+    (error "Error in inoutr-int2")))
+
+(let ((lst (out-foo 4)))
+  (if (not (and (= (slot-ref (car lst) 'a) 4) (= (cadr lst) 8)))
+    (error "Error in out-foo")))
+
+(exit 0)

SWIG/Examples/test-suite/schemerunme/multiple_inheritance_proxy.scm

@@ -0,0 +1,15 @@
+(define-macro (check test)
+  `(if (not ,test) (error "Error in test" ',test)))
+
+(define b (make <Bar>))
+(check (= (bar b) 1))
+
+(define f (make <Foo>))
+(check (= (foo f) 2))
+
+(define fb (make <FooBar>))
+(check (= (bar fb) 1))
+(check (= (foo fb) 2))
+(check (= (fooBar fb) 3))
+
+(exit 0)

SWIG/Examples/test-suite/schemerunme/unions_proxy.scm

@@ -0,0 +1,37 @@
+;;; This is the union runtime testcase. It ensures that values within a
+;;; union embedded within a struct can be set and read correctly.
+
+;; Create new instances of SmallStruct and BigStruct for later use
+(define small (make <SmallStruct>))
+(slot-set! small 'jill 200)
+
+(define big (make <BigStruct>))
+(slot-set! big 'smallstruct small)
+(slot-set! big 'jack 300)
+
+;; Use SmallStruct then BigStruct to setup EmbeddedUnionTest.
+;; Ensure values in EmbeddedUnionTest are set correctly for each.
+(define eut (make <EmbeddedUnionTest>))
+
+;; First check the SmallStruct in EmbeddedUnionTest
+(slot-set! eut 'number 1)
+(slot-set! (slot-ref eut 'uni) 'small small)
+(let ((Jill1 (slot-ref
+	       (slot-ref 
+		  (slot-ref eut 'uni) 
+		  'small)
+	       'jill)))
+  (if (not (= Jill1 200))
+      (begin
+	(display "Runtime test 1 failed.")
+	(exit 1))))
+
+(let ((Num1 (slot-ref eut 'number)))
+  (if (not (= Num1 1))
+      (begin
+	(display "Runtime test 2 failed.")
+	(exit 1))))
+
+;; that should do
+
+(exit 0)