Source

scheme-bert / test / tests.ss

#!r6rs
(import (scheme-bert)
        (rnrs)
        (rnrs bytevectors)
        (rnrs io ports)
        ;; Uncomment next line if you use Racket
        ;(srfi :19)
        ;; Uncomment next line if you use Chez Scheme
        ;(only (chezscheme) time-nanosecond time-second time? make-time)
        )

; Calling of these procs independently is useful for testing purposes:
; 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))))))))