www.artulab.com Git - guile-orca/blob - tests/test_serialization_rpc-apply-scatter.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-scatter-serialization-tests")
  22
  23 ;; integer test
  24
  25 (define actual 10)
  26
  27 (define r (car (rpc-apply-scatter test-payload '("integer") `(,actual))))
  28
  29 (test-assert "integer test" (equal? r actual))
  30
  31 ;; floadint point test
  32
  33 (set! actual 3.14159265358979323846)
  34
  35 (set! r (car (rpc-apply-scatter test-payload '("float") `(,actual))))
  36
  37 (test-assert "float test" (equal? r actual))
  38
  39 ;; rational number test
  40
  41 (set! actual 11/7)
  42
  43 (set! r (car (rpc-apply-scatter test-payload '("rational") `(,actual))))
  44
  45 (test-assert "rational test" (equal? r actual))
  46
  47 ;; boolean test
  48
  49 (set! actual #f)
  50
  51 (set! r (car (rpc-apply-scatter test-payload '("boolean") `(,actual))))
  52
  53 (test-assert "boolean test" (equal? r actual))
  54
  55 ;; pair test
  56
  57 (set! actual '(1 . 2))
  58
  59 (set! r (car (rpc-apply-scatter test-payload '("pair") `(,actual))))
  60
  61 (test-assert "pair test" (equal? r actual))
  62
  63 ;; list test
  64
  65 (set! actual '(1 2 3))
  66
  67 (set! r (car (rpc-apply-scatter test-payload '("list") `(,actual))))
  68
  69 (test-assert "list test" (equal? r actual))
  70
  71 ;; null test
  72
  73 (set! actual '())
  74
  75 (set! r (car (rpc-apply-scatter test-payload '("null") `(,actual))))
  76
  77 (test-assert "null test" (equal? r actual))
  78
  79 ;; list in list test
  80
  81 (set! actual '((1 2 3)))
  82
  83 (set! r (car (rpc-apply-scatter test-payload '("listinlist") `(,actual))))
  84
  85 (test-assert "listlist test" (equal? r actual))
  86
  87 ;; vector test
  88
  89 (set! actual #(1 2 3))
  90
  91 (set! r (car (rpc-apply-scatter test-payload '("vector") `(,actual))))
  92
  93 (test-assert "vector test" (equal? r actual))
  94
  95 ;; vector test
  96
  97 (set! actual #(1 2 3))
  98
  99 (set! r (car (rpc-apply-scatter test-payload '("vector") `(,actual))))
 100
 101 (test-assert "vector test" (equal? r actual))
 102
 103 ;; array test
 104
 105 (set! actual #2((1 2 3) (4 5 6)))
 106
 107 (set! r (car (rpc-apply-scatter test-payload '("array") `(,actual))))
 108
 109 (test-assert "array test" (equal? r actual))
 110
 111 ;; bytevector test
 112
 113 (set! actual #vu8(1 2 3))
 114
 115 (set! r (car (rpc-apply-scatter test-payload '("bytevector") `(,actual))))
 116
 117 (test-assert "bytevector test" (equal? r actual))
 118
 119 ;; alist test
 120
 121 (set! actual '((foo . 1) (bar . 2)))
 122
 123 (set! r (car (rpc-apply-scatter test-payload '("alist") `(,actual))))
 124
 125 (test-assert "alist test" (equal? r actual))
 126
 127 (test-end "rpc-apply-scatter-serialization-tests")
 128
 129 (rpc-finalize)