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

 1(define-macro (check func val test)
 2  (cons 'begin
 3    (map
 4      (lambda (x) 
 5        `(if (not (,test (,(string->symbol (string-append x func)) ,val) ,val))
 6           (error ,(string-append "Error in test " x func))))
 7      (list "in-" "inr-" "out-" "outr-" "inout-" "inoutr-"))))
 8
 9(define (=~ a b)
10  (< (abs (- a b)) 1e-5))
11                      
12(check "bool" #t and)
13(check "int" -2 =)
14(check "long" -32 =)
15(check "short" -15 =)
16(check "uint" 75 =)
17(check "ushort" 123 =)
18(check "ulong" 462 =)
19;(check "uchar" 16 =)
20;(check "schar" -53 =)
21(check "float" 4.3 =~)
22(check "double" -175.42 =~)
23(check "longlong" 1634 =)
24(check "ulonglong" 6432 =)
25
26;; The checking of inoutr-int2 and out-foo is done in the individual
27;; language runme scripts, since chicken returns multiple values
28;; and must be checked with call-with-values, while guile just returns a list
29
30;(call-with-values (lambda () (inoutr-int2 3 -2))
31;		  (lambda (a b)
32;		    (if (not (and (= a 3) (= b -2)))
33;		      (error "Error in inoutr-int2"))))
34;(call-with-values (lambda () (out-foo 4))
35;		  (lambda (a b)
36;		    (if (not (and (= (slot-ref a 'a) 4) (= b 8)))
37;		      (error "Error in out-foo"))))
38
39;(let ((lst (inoutr-int2 3 -2)))
40;  (if (not (and (= (car lst) 3) (= (cadr lst) -2)))
41;    (error "Error in inoutr-int2")))
42
43;(let ((lst (out-foo 4)))
44;  (if (not (and (= (slot-ref (car lst) 'a) 4) (= (cadr lst) 8)))
45;    (error "Error in out-foo")))