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

 1;;; This is the union runtime testcase. It ensures that values within a
 2;;; union embedded within a struct can be set and read correctly.
 3
 4;; Create new instances of SmallStruct and BigStruct for later use
 5(define small (make <SmallStruct>))
 6(slot-set! small 'jill 200)
 7
 8(define big (make <BigStruct>))
 9(slot-set! big 'smallstruct small)
10(slot-set! big 'jack 300)
11
12;; Use SmallStruct then BigStruct to setup EmbeddedUnionTest.
13;; Ensure values in EmbeddedUnionTest are set correctly for each.
14(define eut (make <EmbeddedUnionTest>))
15
16;; First check the SmallStruct in EmbeddedUnionTest
17(slot-set! eut 'number 1)
18(slot-set! (slot-ref eut 'uni) 'small small)
19(let ((Jill1 (slot-ref
20	       (slot-ref 
21		  (slot-ref eut 'uni) 
22		  'small)
23	       'jill)))
24  (if (not (= Jill1 200))
25      (begin
26	(display "Runtime test 1 failed.")
27	(exit 1))))
28
29(let ((Num1 (slot-ref eut 'number)))
30  (if (not (= Num1 1))
31      (begin
32	(display "Runtime test 2 failed.")
33	(exit 1))))
34
35;; that should do
36
37(exit 0)