PageRenderTime 25ms CodeModel.GetById 0ms RepoModel.GetById 0ms app.codeStats 0ms

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

#
Lisp | 37 lines | 23 code | 7 blank | 7 comment | 0 complexity | b0092d99f2b0a18df5a924c69bc65648 MD5 | raw file
Possible License(s): LGPL-2.1, Cube, GPL-3.0, 0BSD, GPL-2.0
  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. ;; Create new instances of SmallStruct and BigStruct for later use
  4. (define small (make <SmallStruct>))
  5. (slot-set! small 'jill 200)
  6. (define big (make <BigStruct>))
  7. (slot-set! big 'smallstruct small)
  8. (slot-set! big 'jack 300)
  9. ;; Use SmallStruct then BigStruct to setup EmbeddedUnionTest.
  10. ;; Ensure values in EmbeddedUnionTest are set correctly for each.
  11. (define eut (make <EmbeddedUnionTest>))
  12. ;; First check the SmallStruct in EmbeddedUnionTest
  13. (slot-set! eut 'number 1)
  14. (slot-set! (slot-ref eut 'uni) 'small small)
  15. (let ((Jill1 (slot-ref
  16. (slot-ref
  17. (slot-ref eut 'uni)
  18. 'small)
  19. 'jill)))
  20. (if (not (= Jill1 200))
  21. (begin
  22. (display "Runtime test 1 failed.")
  23. (exit 1))))
  24. (let ((Num1 (slot-ref eut 'number)))
  25. (if (not (= Num1 1))
  26. (begin
  27. (display "Runtime test 2 failed.")
  28. (exit 1))))
  29. ;; that should do
  30. (exit 0)