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