update swig on windows
This commit is contained in:
@@ -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)
|
||||
@@ -0,0 +1,4 @@
|
||||
(if (and (char? (CHAR-CONSTANT))
|
||||
(string? (STRING-CONSTANT)))
|
||||
(exit 0)
|
||||
(exit 1))
|
||||
@@ -0,0 +1,6 @@
|
||||
(define a (new-Bar))
|
||||
|
||||
(if (not (string=? (Bar-blah a) "Bar::blah"))
|
||||
(error "Wrong string"))
|
||||
|
||||
(exit 0)
|
||||
@@ -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)
|
||||
@@ -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))
|
||||
|
||||
(exit 0)
|
||||
@@ -0,0 +1,21 @@
|
||||
(define f (new-Foo))
|
||||
|
||||
(if (not (= (Foo-hola-get f) (Foo-Hello)))
|
||||
(error "Error 1"))
|
||||
|
||||
(Foo-hola-set f (Foo-Hi))
|
||||
|
||||
(if (not (= (Foo-hola-get f) (Foo-Hi)))
|
||||
(error "Error 2"))
|
||||
|
||||
(Foo-hola-set f (Foo-Hello))
|
||||
|
||||
(if (not (= (Foo-hola-get f) (Foo-Hello)))
|
||||
(error "Error 3"))
|
||||
|
||||
(hi (Hello))
|
||||
|
||||
(if (not (= (hi) (Hello)))
|
||||
(error "Error 4"))
|
||||
|
||||
(exit 0)
|
||||
@@ -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)
|
||||
@@ -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)
|
||||
@@ -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)
|
||||
@@ -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)
|
||||
@@ -0,0 +1,7 @@
|
||||
(define f (create-Foo))
|
||||
(test1 f 42)
|
||||
|
||||
(define b (new-Bar))
|
||||
(test1 b 37)
|
||||
|
||||
(exit 0)
|
||||
@@ -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)
|
||||
@@ -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)
|
||||
@@ -0,0 +1,49 @@
|
||||
(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))))
|
||||
|
||||
(define-macro (check-range function from to)
|
||||
`(begin (check-equality (,function ,from) ,from)
|
||||
(check-equality (,function ,to) ,to)
|
||||
(check-equality (throws-exception? (,function (- ,from 1))) #t)
|
||||
(check-equality (throws-exception? (,function (+ ,to 1))) #t)))
|
||||
|
||||
(let ((signed-short-min (- (expt 2 (- (* (signed-short-size) 8) 1))))
|
||||
(signed-short-max (- (expt 2 (- (* (signed-short-size) 8) 1)) 1))
|
||||
(unsigned-short-max (- (expt 2 (* (unsigned-short-size) 8)) 1))
|
||||
(signed-int-min (- (expt 2 (- (* (signed-int-size) 8) 1))))
|
||||
(signed-int-max (- (expt 2 (- (* (signed-int-size) 8) 1)) 1))
|
||||
(unsigned-int-max (- (expt 2 (* (unsigned-int-size) 8)) 1))
|
||||
(signed-long-min (- (expt 2 (- (* (signed-long-size) 8) 1))))
|
||||
(signed-long-max (- (expt 2 (- (* (signed-long-size) 8) 1)) 1))
|
||||
(unsigned-long-max (- (expt 2 (* (unsigned-long-size) 8)) 1))
|
||||
(signed-long-long-min (- (expt 2 (- (* (signed-long-long-size) 8) 1))))
|
||||
(signed-long-long-max (- (expt 2 (- (* (signed-long-long-size) 8) 1)) 1))
|
||||
(unsigned-long-long-max (- (expt 2 (* (unsigned-long-long-size) 8)) 1))
|
||||
)
|
||||
|
||||
;;; signed char, unsigned char typemaps deal with characters, not integers.
|
||||
;; (check-range signed-char-identity (- (expt 2 7)) (- (expt 2 7) 1))
|
||||
;; (check-range unsigned-char-identity 0 (- (expt 2 8) 1))
|
||||
(check-range signed-short-identity signed-short-min signed-short-max)
|
||||
(check-range unsigned-short-identity 0 unsigned-short-max)
|
||||
(check-range signed-int-identity signed-int-min signed-int-max)
|
||||
(check-range unsigned-int-identity 0 unsigned-int-max)
|
||||
(check-range signed-long-identity signed-long-min signed-long-max)
|
||||
(check-range signed-long-long-identity signed-long-long-min signed-long-long-max)
|
||||
|
||||
;;; unsigned (long) long is broken in guile 1.8 on Mac OS X, skip test
|
||||
(if (or (>= (string->number (major-version)) 2)
|
||||
(not (equal? (utsname:sysname (uname)) "Darwin")))
|
||||
(begin
|
||||
(check-range unsigned-long-identity 0 unsigned-long-max)
|
||||
(check-range unsigned-long-long-identity 0 unsigned-long-long-max))
|
||||
)
|
||||
|
||||
)
|
||||
|
||||
(exit 0)
|
||||
@@ -0,0 +1,48 @@
|
||||
; The test string has some non-ascii characters added
|
||||
; because our guile wrappers had bugs in that area
|
||||
(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 (new-Structure))
|
||||
|
||||
;; MemberString should be a wrapped class
|
||||
(define scl (Structure-MemberString-get struct))
|
||||
(if (not (string=? scl ""))
|
||||
(error "Error 4.5"))
|
||||
(Structure-MemberString-set struct "and how")
|
||||
(if (not (string=? (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)
|
||||
@@ -0,0 +1,45 @@
|
||||
(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 =)
|
||||
|
||||
;; The checking of inoutr-int2 and out-foo is done in the individual
|
||||
;; language runme scripts, since chicken returns multiple values
|
||||
;; and must be checked with call-with-values, while guile just returns a list
|
||||
|
||||
;(call-with-values (lambda () (inoutr-int2 3 -2))
|
||||
; (lambda (a b)
|
||||
; (if (not (and (= a 3) (= b -2)))
|
||||
; (error "Error in inoutr-int2"))))
|
||||
;(call-with-values (lambda () (out-foo 4))
|
||||
; (lambda (a b)
|
||||
; (if (not (and (= (Foo-a-get a) 4) (= b 8)))
|
||||
; (error "Error in out-foo"))))
|
||||
|
||||
;(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")))
|
||||
@@ -0,0 +1,45 @@
|
||||
(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 =)
|
||||
|
||||
;; The checking of inoutr-int2 and out-foo is done in the individual
|
||||
;; language runme scripts, since chicken returns multiple values
|
||||
;; and must be checked with call-with-values, while guile just returns a list
|
||||
|
||||
;(call-with-values (lambda () (inoutr-int2 3 -2))
|
||||
; (lambda (a b)
|
||||
; (if (not (and (= a 3) (= b -2)))
|
||||
; (error "Error in inoutr-int2"))))
|
||||
;(call-with-values (lambda () (out-foo 4))
|
||||
; (lambda (a b)
|
||||
; (if (not (and (= (slot-ref a 'a) 4) (= b 8)))
|
||||
; (error "Error in out-foo"))))
|
||||
|
||||
;(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")))
|
||||
@@ -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)
|
||||
@@ -0,0 +1,31 @@
|
||||
(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))
|
||||
|
||||
(define id1 (make <IgnoreDerived1>))
|
||||
(check (= (bar id1) 1))
|
||||
(check (= (ignorederived1 id1) 7))
|
||||
|
||||
(define id2 (make <IgnoreDerived2>))
|
||||
(check (= (bar id2) 1))
|
||||
(check (= (ignorederived2 id2) 8))
|
||||
|
||||
(define id3 (make <IgnoreDerived3>))
|
||||
(check (= (bar id3) 1))
|
||||
(check (= (ignorederived3 id3) 9))
|
||||
|
||||
(define id4 (make <IgnoreDerived4>))
|
||||
(check (= (bar id4) 1))
|
||||
(check (= (ignorederived4 id4) 10))
|
||||
|
||||
(exit 0)
|
||||
@@ -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)
|
||||
|
||||
@@ -0,0 +1,5 @@
|
||||
(foo-2)
|
||||
bar-2
|
||||
Baz-2
|
||||
|
||||
(exit 0)
|
||||
@@ -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)
|
||||
@@ -0,0 +1,4 @@
|
||||
(define f (new-Foo))
|
||||
(define g (new-Foo f))
|
||||
|
||||
(exit 0)
|
||||
@@ -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) 6.0))
|
||||
(error "test reals bad"))
|
||||
|
||||
(exit 0)
|
||||
@@ -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) 6.0))
|
||||
(error "test reals bad"))
|
||||
|
||||
(exit 0)
|
||||
@@ -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)
|
||||
@@ -0,0 +1,7 @@
|
||||
(if (not (= (spam (new-Foo)) 1))
|
||||
(error "foo"))
|
||||
|
||||
(if (not (= (spam (new-Bar)) 2))
|
||||
(error "bar"))
|
||||
|
||||
(exit 0)
|
||||
@@ -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)
|
||||
@@ -0,0 +1,67 @@
|
||||
(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 #\newline))
|
||||
(if (not (char=? (value-unsigned-char (var-unsigned-char)) #\newline))
|
||||
(begin (display "Runtime test 4 failed.\n") (exit 1)))
|
||||
|
||||
(var-signed-char (createref-signed-char #\newline))
|
||||
(if (not (char=? (value-signed-char (var-signed-char)) #\newline))
|
||||
(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)))
|
||||
|
||||
; Test garbage collection on guile >= 2.0.12
|
||||
(if (or (and (string=? (major-version) "2")
|
||||
(string=? (minor-version) "0")
|
||||
(string>=? (micro-version) "12"))
|
||||
(and (string>=? (major-version) "2")
|
||||
(string>=? (minor-version) "1")))
|
||||
(gc))
|
||||
|
||||
(exit 0)
|
||||
@@ -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)
|
||||
@@ -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)
|
||||
@@ -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)
|
||||
@@ -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)
|
||||
Reference in New Issue
Block a user