www.artulab.com Git - guile-orca/blob - tests/test_serialization_rpc-apply-bcast.scm

   1 #!/usr/bin/env -S guile -s
   2 !#
   3
   4 (add-to-load-path "..")
   5 (use-modules (srfi srfi-1))
   6 (use-modules (srfi srfi-9))
   7 (use-modules (srfi srfi-9 gnu))
   8 (use-modules (srfi srfi-64))
   9 (use-modules (orca))
  10 (use-modules (rnrs bytevectors))
  11
  12 (define (test-payload test payload)
  13   (format #t "--Testing ~s: Payload ~a~%" test payload)
  14   (flush-all-ports)
  15   (case (string->symbol test)
  16     ((record) 'record)
  17     (else payload)))
  18
  19 (rpc-start)
  20
  21 (test-begin "rpc-apply-bcast-serialization-tests")
  22
  23 ;; integer test
  24
  25 (define actual 10)
  26
  27 (define r (car (rpc-apply-bcast test-payload "integer" actual)))
  28
  29 (test-assert "integer test" (equal? r actual))
  30
  31 (test-end "rpc-apply-bcast-serialization-tests")
  32
  33 ;; floadint point test
  34
  35 (set! actual 3.14159265358979323846)
  36
  37 (set! r (car (rpc-apply-bcast test-payload "float" actual)))
  38
  39 (test-assert "float test" (equal? r actual))
  40
  41 ;; rational number test
  42
  43 (set! actual 11/7)
  44
  45 (set! r (car (rpc-apply-bcast test-payload "rational" actual)))
  46
  47 (test-assert "rational test" (equal? r actual))
  48
  49 ;; boolean test
  50
  51 (set! actual #f)
  52
  53 (set! r (car (rpc-apply-bcast test-payload "boolean" actual)))
  54
  55 (test-assert "boolean test" (equal? r actual))
  56
  57 ;; pair test
  58
  59 (set! actual '(1 . 2))
  60
  61 (set! r (car (rpc-apply-bcast test-payload "pair" actual)))
  62
  63 (test-assert "pair test" (equal? r actual))
  64
  65 ;; list test
  66
  67 (set! actual '(1 2 3))
  68
  69 (set! r (car (rpc-apply-bcast test-payload "list" actual)))
  70
  71 (test-assert "list test" (equal? r actual))
  72
  73 ;; null test
  74
  75 (set! actual '())
  76
  77 (set! r (car (rpc-apply-bcast test-payload "null" actual)))
  78
  79 (test-assert "null test" (equal? r actual))
  80
  81 ;; list in list test
  82
  83 (set! actual '((1 2 3)))
  84
  85 (set! r (car (rpc-apply-bcast test-payload "listinlist" actual)))
  86
  87 (test-assert "listlist test" (equal? r actual))
  88
  89 ;; vector test
  90
  91 (set! actual #(1 2 3))
  92
  93 (set! r (car (rpc-apply-bcast test-payload "vector" actual)))
  94
  95 (test-assert "vector test" (equal? r actual))
  96
  97 ;; vector test
  98
  99 (set! actual #(1 2 3))
 100
 101 (set! r (car (rpc-apply-bcast test-payload "vector" actual)))
 102
 103 (test-assert "vector test" (equal? r actual))
 104
 105 ;; array test
 106
 107 (set! actual #2((1 2 3) (4 5 6)))
 108
 109 (set! r (car (rpc-apply-bcast test-payload "array" actual)))
 110
 111 (test-assert "array test" (equal? r actual))
 112
 113 ;; bytevector test
 114
 115 (set! actual #vu8(1 2 3))
 116
 117 (set! r (car (rpc-apply-bcast test-payload "bytevector" actual)))
 118
 119 (test-assert "bytevector test" (equal? r actual))
 120
 121 ;; alist test
 122
 123 (set! actual '((foo . 1) (bar . 2)))
 124
 125 (set! r (car (rpc-apply-bcast test-payload "alist" actual)))
 126
 127 (test-assert "alist test" (equal? r actual))
 128
 129 (rpc-finalize)