The guile and chicken _runme scripts are now shared

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

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

@@ -0,0 +1,8 @@
+(define x (new-B))
+
+;; This fails in 1.3a5 because the SWIG/Guile runtime code gets the
+;; source and the target of a cast the wrong way around.
+
+(A-hello x)				
+
+(exit 0)

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

@@ -0,0 +1,4 @@
+(if (and (char? (CHAR-CONSTANT))
+	 (string? (STRING-CONSTANT)))
+    (exit 0)
+    (exit 1))

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

@@ -0,0 +1,6 @@
+(define a (new-Bar))
+
+(if (not (string=? (Bar-blah a) "Bar::blah"))
+    (error "Wrong string"))
+
+(exit 0)

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

@@ -0,0 +1,26 @@
+(define p (test "test"))
+(if (not (string=? p "test"))
+    (error "test failed!"))
+
+(set! p (test-pconst "test"))
+(if (not (string=? p "test_pconst"))
+    (error "test_pconst failed!"))
+
+(define f (new-Foo))
+(set! p (Foo-test f "test"))
+(if (not (string=? p "test"))
+    (error "member-test failed!"))
+
+(set! p (Foo-test-pconst f "test"))
+(if (not (string=? p "test_pconst"))
+    (error "member-test_pconst failed!"))
+
+(set! p (Foo-test-constm f "test"))
+(if (not (string=? p "test_constmethod"))
+    (error "member-test_constm failed!"))
+
+(set! p (Foo-test-pconstm f "test"))
+(if (not (string=? p "test_pconstmethod"))
+    (error "member-test_pconstm failed!"))
+
+(exit 0)

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

@@ -0,0 +1,14 @@
+(test-preassert 1 2)
+(expect-throw 'swig-contract-assertion-failed
+	      (test-preassert -1 2))
+(test-postassert 3)
+(expect-throw 'swig-contract-assertion-failed
+	      (test-postassert -3))
+(test-prepost 2 3)
+(test-prepost 5 -4)
+(expect-throw 'swig-contract-assertion-failed
+	      (test-prepost -3 4))
+(expect-throw 'swig-contract-assertion-failed
+	      (test-prepost 4 -10))
+
+(quit)

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

@@ -0,0 +1,42 @@
+(define n (fact 4))
+(if (not (= n 24))
+    (error "Bad return value!"))
+
+(if (not (= (Foo) 42))
+    (error "bad variable value!"))
+
+(define t (new-Test))
+(if (not (string=? (Test-method t) "Test::method"))
+    (error "Bad method return value!"))
+
+(if (not (string=? (do-method t) "Test::method"))
+    (error "Bad return value!"))
+
+(if (not (string=? (do-method2 t) "Test::method"))
+    (error "Bad return value!"))
+
+(weird "hello" 4)
+
+;; (delete-Test t)
+
+(define t2 (new-Test2))
+(define t3 (new-Test3))
+(define t4 (new-Test4))
+(define t5 (new-Test5))
+
+(if (not (= (foo3 42) 42))
+    (error "Bad return value!"))
+
+(if (not (string=? (do-method3 t2 40) "Test2::method"))
+    (error "bad return value!"))
+
+(if (not (string=? (do-method3 t3 40) "Test3::method"))
+    (error "bad return value"))
+
+(if (not (string=? (do-method3 t4 40) "Test4::method"))
+    (error "bad return value"))
+
+(if (not (string=? (do-method3 t5 40) "Test5::method"))
+    (error "bad return value"))
+
+(exit 0)

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

@@ -0,0 +1,11 @@
+(define f (new-Foo))
+(define b (new-Bar))
+
+(define x (Foo-blah f))
+(define y (Bar-blah b))
+
+(define a (do-test y))
+(if (not (string=? a "Bar::test"))
+    (error "Failed!"))
+
+(exit 0)

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

@@ -0,0 +1,7 @@
+(define f (create-Foo))
+(test1 f 42)
+
+(define b (new-Bar))
+(test1 b 37)
+
+(exit 0)

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

@@ -0,0 +1,13 @@
+;;; This file is part of a test for SF bug #231619. 
+;;; It shows that the %import directive does not work properly in SWIG
+;;; 1.3a5:  Type information is not properly generated if a base class
+;;; comes from an %import-ed file. 
+
+(define x (new-B))
+
+;; This fails in 1.3a5 because the SWIG runtime code does not know
+;; that x (an instance of class B) can be passed to methods of class A. 
+
+(A-hello x)				
+
+(exit 0)

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

@@ -0,0 +1,14 @@
+(define a (new-Foo))
+(define b (new-Bar))
+(define c (new-Spam))
+
+(if (not (string=? (do-blah a) "Foo::blah"))
+    (error "Bad return"))
+
+(if (not (string=? (do-blah b) "Bar::blah"))
+    (error "Bad return"))
+
+(if (not (string=? (do-blah c) "Spam::blah"))
+    (error "bad return"))
+
+(exit 0)

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

@@ -0,0 +1,26 @@
+(define-macro (check-equality form1 form2)
+  `(let ((result1 ,form1)
+	 (result2 ,form2))
+     (if (not (equal? result1 result2))
+	 (error "Check failed:"
+		(list 'equal? ',form1 ',form2)
+		result1 result2))))
+
+(check-equality (sum-list '(1 3 4 6 7)) 21.0)
+(check-equality (sum-vector #(2 4 6 7 9)) 28.0)
+(check-equality (one-to-seven-list) '(1 2 3 4 5 6 7))
+(check-equality (one-to-seven-vector) #(1 2 3 4 5 6 7))
+
+(check-equality (sum-list2 '(1 3 4 6 7)) 21.0)
+(check-equality (sum-vector2 #(2 4 6 7 9)) 28.0)
+(check-equality (one-to-seven-list2) '(1 2 3 4 5 6 7))
+(check-equality (one-to-seven-vector2) #(1 2 3 4 5 6 7))
+
+(check-equality (sum-lists '(1 2 3) '(4 5 6) '(7 8 9)) 45.0)
+(check-equality (sum-lists2 '(1 2 3) '(4 5 6) '(7 8 9)) 45.0)
+(check-equality (call-with-values produce-lists list)
+	       '(#(0 1 2 3 4)
+		 #(0 1 4 9 16)
+		 #(0.0 1.5 3.0 4.5 6.0)))
+
+(exit 0)

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

@@ -0,0 +1,19 @@
+;;;; Automatic test of multiple return values
+
+(let ((quotient/remainder (divide-l 37 5)))
+  (if (not (equal? quotient/remainder '(7 2)))
+      (exit 1)))
+
+(let ((quotient-remainder-vector (divide-v 41 7)))
+  (if (not (equal? quotient-remainder-vector #(5 6)))
+      (exit 1)))
+
+(call-with-values (lambda ()
+		    (divide-mv 91 13))
+		  (lambda (quotient remainder)
+		    (if (not (and (= quotient 7)
+				  (= remainder 0)))
+			(exit 1))))
+
+(exit 0)
+			     

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

@@ -0,0 +1,5 @@
+(foo-2)
+bar-2
+Baz-2
+
+(exit 0)

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

@@ -0,0 +1,16 @@
+(define-macro (check form)
+  `(if (not ,form)
+       (error "Check failed: " ',form)))
+
+(define (=~ a b)
+  (< (abs (- a b)) 1e-8))
+
+;; Check first method
+(check (=~ (foo 1 2 "bar" 4) 15))
+
+;; Check second method
+(check (=~ (foo 1 2) 4811.4))
+(check (=~ (foo 1 2 3.2) 4797.2))
+(check (=~ (foo 1 2 3.2 #\Q) 4798.2))
+
+(exit 0)

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

@@ -0,0 +1,4 @@
+(define f (new-Foo))
+(define g (new-Foo f))
+
+(exit 0)

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

@@ -0,0 +1,12 @@
+(define f (new-Foo))
+
+(if (not (= (Foo-test f 3) 1))
+    (error "test integer bad"))
+
+(if (not (= (Foo-test f "hello") 2))
+    (error "test string bad"))
+
+(if (not (= (Foo-test f 3.5 2.5) 3))
+    (error "test reals bad"))
+
+(exit 0)

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

@@ -0,0 +1,51 @@
+(if (not (string=? (foo 3) "foo:int"))
+    (error "foo(int)"))
+
+(if (not (string=? (foo 3.01) "foo:double"))
+    (error "foo(double)"))
+
+(if (not (string=? (foo "hello") "foo:char *"))
+    (error "foo(char *)"))
+
+(let ((f (new-Foo))
+      (b (new-Bar))
+      (s (new-Spam)))
+  (if (not (string=? (foo f) "foo:Foo *"))
+      (error "foo(Foo *)"))
+  (if (not (string=? (foo b) "foo:Bar *"))
+      (error "foo(Bar *)"))
+  ;; Test member functions
+  (if (not (string=? (Spam-foo s 3) "foo:int"))
+      (error "Spam::foo(int)"))
+  (if (not (string=? (Spam-foo s 3.01) "foo:double"))
+      (error "Spam::foo(double)"))
+  (if (not (string=? (Spam-foo s "hello") "foo:char *"))
+      (error "Spam::foo(char *)"))
+  (if (not (string=? (Spam-foo s f) "foo:Foo *"))
+      (error "Spam::foo(Foo *)"))
+  (if (not (string=? (Spam-foo s b) "foo:Bar *"))
+      (error "Spam::foo(Bar *)"))
+  ;; Test static member functions
+  (if (not (string=? (Spam-bar 3) "bar:int"))
+      (error "Spam::bar(int)"))
+  (if (not (string=? (Spam-bar 3.01) "bar:double"))
+      (error "Spam::bar(double)"))
+  (if (not (string=? (Spam-bar "hello") "bar:char *"))
+      (error "Spam::bar(char *)"))
+  (if (not (string=? (Spam-bar f) "bar:Foo *"))
+      (error "Spam::bar(Foo *)"))
+  (if (not (string=? (Spam-bar b) "bar:Bar *"))
+      (error "Spam::bar(Bar *)"))
+  ;; Test constructors
+  (if (not (string=? (Spam-type-get (new-Spam)) "none"))
+      (error "Spam()"))
+  (if (not (string=? (Spam-type-get (new-Spam 3)) "int"))
+      (error "Spam(int)"))
+  (if (not (string=? (Spam-type-get (new-Spam 3.4)) "double"))
+      (error "Spam(double)"))
+  (if (not (string=? (Spam-type-get (new-Spam "hello")) "char *"))
+      (error "Spam(char *)"))
+  (if (not (string=? (Spam-type-get (new-Spam b)) "Bar *"))
+      (error "Spam(Bar *)")))
+
+(exit 0)

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

@@ -0,0 +1,7 @@
+(if (not (= (spam (new-Foo)) 1))
+    (error "foo"))
+
+(if (not (= (spam (new-Bar)) 2))
+    (error "bar"))
+
+(exit 0)

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

@@ -0,0 +1,13 @@
+(define-macro (check form)
+  `(if (not ,form)
+       (error "Check failed: " ',form)))
+
+(define p (produce-int-pointer 47 11))
+
+(check (= (consume-int-pointer p) 47))
+
+(define q (frobnicate-int-pointer p))
+
+(check (= (consume-int-pointer q) 11))
+
+(exit 0)

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

@@ -0,0 +1,59 @@
+(define (!= a b) (not (= a b)))
+
+; const class reference variable
+(if (!= (TestClass-num-get (getconstTC)) 33)
+  (begin (display "Runtime test 1 failed.\n") (exit 1)))
+
+; primitive reference variables
+(var-bool (createref-bool #f))
+(if (value-bool (var-bool))
+  (begin (display "Runtime test 2 failed.\n") (exit 1)))
+
+(var-char (createref-char #\w))
+(if (not (char=? (value-char (var-char)) #\w))
+  (begin (display "Runtime test 3 failed.\n") (exit 1)))
+
+(var-unsigned-char (createref-unsigned-char #\nl))
+(if (not (char=? (value-unsigned-char (var-unsigned-char)) #\nl))
+  (begin (display "Runtime test 4 failed.\n") (exit 1)))
+
+(var-signed-char (createref-signed-char #\nl))
+(if (not (char=? (value-signed-char (var-signed-char)) #\nl))
+  (begin (display "Runtime test 5 failed.\n") (exit 1)))
+
+(var-unsigned-short (createref-unsigned-short 10))
+(if (!= (value-unsigned-short (var-unsigned-short)) 10)
+  (begin (display "Runtime test 6 failed.\n") (exit 1)))
+
+(var-int (createref-int 10))
+(if (!= (value-int (var-int)) 10)
+  (begin (display "Runtime test 7 failed.\n") (exit 1)))
+
+(var-unsigned-int (createref-unsigned-int 10))
+(if (!= (value-unsigned-int (var-unsigned-int)) 10)
+  (begin (display "Runtime test 8 failed.\n") (exit 1)))
+
+(var-long (createref-long 10))
+(if (!= (value-long (var-long)) 10)
+  (begin (display "Runtime test 9 failed.\n") (exit 1)))
+
+(var-unsigned-long (createref-unsigned-long 10))
+(if (!= (value-unsigned-long (var-unsigned-long)) 10)
+  (begin (display "Runtime test 10 failed.\n") (exit 1)))
+
+;skip long long and unsigned long long
+
+(var-float (createref-float 10.5))
+(if (!= (value-float (var-float)) 10.5)
+  (begin (display "Runtime test 11 failed.\n") (exit 1)))
+
+(var-double (createref-double 10.55))
+(if (!= (value-double (var-double)) 10.55)
+  (begin (display "Runtime test 12 failed.\n") (exit 1)))
+
+;class reference
+(var-TestClass (createref-TestClass (new-TestClass 20)))
+(if (!= (TestClass-num-get (value-TestClass (var-TestClass))) 20)
+  (begin (display "Runtime test 13 failed.\n") (exit 1)))
+
+(exit 0)

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

@@ -0,0 +1,19 @@
+(define a (new-Foo))
+(define b (new-Bar))
+
+(if (not (string=? (do-blah a) "Foo::blah"))
+    (error "bad return"))
+
+(if (not (string=? (do-blah b) "Bar::blah"))
+    (error "bad return"))
+
+(define c (new-Spam))
+(define d (new-Grok))
+
+(if (not (string=? (do-blah2 c) "Spam::blah"))
+    (error "bad return"))
+
+(if (not (string=? (do-blah2 d) "Grok::blah"))
+    (error "bad return"))
+
+(exit 0)

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

@@ -0,0 +1,12 @@
+(define f (new-Foo))
+(define b (new-Bar))
+
+(define x (twoFoo f))
+;;(if (not (isinstance x (types-FloatType)))
+;;    (error "wrong return type"))
+
+(define y (twoBar b))
+;;(if (not (isinstance y (types-IntType)))
+;;    (error "wrong return type"))
+
+(exit 0)

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

@@ -0,0 +1,36 @@
+;;; 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 (new-SmallStruct))
+(SmallStruct-jill-set small 200)
+
+(define big (new-BigStruct))
+(BigStruct-smallstruct-set big small)
+(BigStruct-jack-set big 300)
+
+;; Use SmallStruct then BigStruct to setup EmbeddedUnionTest.
+;; Ensure values in EmbeddedUnionTest are set correctly for each.
+(define eut (new-EmbeddedUnionTest))
+
+;; First check the SmallStruct in EmbeddedUnionTest
+(EmbeddedUnionTest-number-set eut 1)
+(EmbeddedUnionTest-uni-small-set (EmbeddedUnionTest-uni-get eut)
+				 small)
+(let ((Jill1 (SmallStruct-jill-get
+	      (EmbeddedUnionTest-uni-small-get
+	       (EmbeddedUnionTest-uni-get eut)))))
+  (if (not (= Jill1 200))
+      (begin
+	(display "Runtime test 1 failed.")
+	(exit 1))))
+
+(let ((Num1 (EmbeddedUnionTest-number-get eut)))
+  (if (not (= Num1 1))
+      (begin
+	(display "Runtime test 2 failed.")
+	(exit 1))))
+
+;; that should do
+
+(exit 0)