Source

scheme-bert / test / tests.ss

#!r6rs
(import (scheme-bert)
        (rnrs)
        (rnrs bytevectors)
        (rnrs io ports)
        ;; Either import SRFI 19 or use 
        ;; builtin functions (as in Chez Scheme))
        (srfi :19)
        ;(only (chezscheme) time-nanosecond time-second time? make-time)
        )

; calling of these procs independently is useful: 
; test-encoder, test-decoder, test-roundtrip

(define (fold/and proc lst)
  (cond
    ((null? lst)
     #t)
    ((proc (car lst))
     (fold/and proc (cdr lst)))
    (else #f)))

(define (checkthis testname expect exprresult)
  (if (equal? expect exprresult)
      #t
      (begin
        (display (string-append testname ": failed"))
        (newline)
        #f)))

(define (test-group tests)
  (let* ((result (map (lambda (x) (x)) tests))
         (suc (filter (lambda (x) x) result))
         (fail (filter not result)))
    (display (string-append (number->string (length suc))  " tests, " 
                            (number->string (length fail)) " failures"))
    (newline) (display "Finished.") (newline)))

(define (test-encoder)
  (display "=== Performing encoder test ===") (newline)
  (test-group (list test-encoder-1
                    test-encoder-time
                    test-bignum)))

(define (test-decoder)
  (display "=== Performing decoder test ===") (newline)
  (test-group (list test-decoder-string
                    test-hash)))

(define (checkthis-bert datum)
  (lambda ()
    (checkthis (call-with-string-output-port
                (lambda (outport) (display datum outport))) 
               (bert-decode (bert-encode datum))
               datum)))

(define (test-roundtrip)
  (display "=== Performing roundtrip tests ===") (newline)
  (test-group (list (checkthis-bert 1)
                    (checkthis-bert 1.0)
                    (checkthis-bert 'a)
                    (checkthis-bert (vector))
                    (checkthis-bert (vector 'a))
                    (checkthis-bert (vector 'a 'b))
                    (checkthis-bert (vector (vector 'a 1) (vector 'b 2)))
                    (checkthis-bert '())
                    (checkthis-bert '(a))
                    (checkthis-bert '(a 1))
                    (checkthis-bert '('(a 1) '(b 2)))
                    (checkthis-bert "a")
                    (checkthis-bert 'nil)
                    (checkthis-bert #t)
                    (checkthis-bert #f)
                    (checkthis-bert (- (expt 256 256) 1))
                    (checkthis-bert 'true)
                    (checkthis-bert 'false))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Encoder test cases
;;
(define (test-encoder-1)
  ; {foo,42,666,{12,[],{255,'Bar'},111222333444555666}}
  (checkthis "test-encoder-1"
             (u8-list->bytevector '(131 104 4 100 0 3 102 111 111 97 42 
                                        98 0 0 2 154 104 4 97 12 106 104 
                                        2 97 255 100 0 3 98 97 114 110 8 
                                        0 146 131 13 124 31 36 139 1))
             (bert-encode 
              (vector 'foo 42 666 
                      (vector 12 '() 
                              (vector 255 'bar) 111222333444555666)))))

(define (test-encoder-time)
  ; {bert, time, <some_day_bleh>}
  (checkthis "test-encoder-time"
             (bert-encode (make-time 'time-utc 42424242 502806141))
             (u8-list->bytevector '(131 104 5 100 0 4 98 101 114 
                                        116 100 0 4 116 105 109 101
                                        98 0 0 1 246 98 0 12 76 253
                                        98 0 0 165 184))))

(define (test-bignum)
  ; http://goo.gl/E9od   Haha
  (checkthis "test-bignum"
             (bert-encode 
              54308428790203478762340052723346983453487023489987231275412390872348475)
             (u8-list->bytevector '(131 110 30 0 59 247 203 187 60 
                                        16 162 156 242 204 91 91 185 
                                        157 61 237 199 186 60 55 104 
                                        86 102 152 206 95 93 105 222 7))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Decoder test cases
;;
(define (test-decoder-string)
  (checkthis "test-decoder-string"
             "Flying Spaghetti Monster"
             (bert-decode
              (u8-list->bytevector '(131 109 0 0 0 24 70 108 121 105 
                                         110 103 32 83 112 97 103 104 
                                         101 116 116 105 32 77 111 110 
                                         115 116 101 114)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Roundtrip (encode->decode and vice versa) test cases
;;
(define (test-hash)
  ; {bert,dict,[{one,1},{two,2},{three,3}]}
  (let ((h1 (make-eqv-hashtable)))
    (hashtable-set! h1 13  'thirteen)
    (hashtable-set! h1 42  'fortytwo)
    (hashtable-set! h1 666 'beast)
    (let ((h2 (bert-decode (bert-encode h1))))
      (let-values (((keys1 vals1) (hashtable-entries h1))
                   ((keys2 vals2) (hashtable-entries h2)))
        (checkthis "test-hash" #t
                   (and
                    (fold/and (lambda (x) (member x (vector->list keys2)))
                              (vector->list keys2))
                    (fold/and (lambda (x) (member x (vector->list vals2)))
                              (vector->list vals2))))))))