Source

scheme-bert / test / tests.ss

Full commit
Yasir M. Arsanuk… 2432571 


Yasir M. Arsanuk… 938d25c 

Yasir M. Arsanuk… b871024 


Yasir M. Arsanuk… 2432571 


Yasir M. Arsanuk… b871024 
Yasir M. Arsanuk… 938d25c 
Yasir M. Arsanuk… 263480b 
Yasir M. Arsanuk… 2432571 









Yasir M. Arsanuk… b871024 




Yasir M. Arsanuk… 2432571 
Yasir M. Arsanuk… 938d25c 

Yasir M. Arsanuk… 2432571 

Yasir M. Arsanuk… 938d25c 








Yasir M. Arsanuk… 2432571 
Yasir M. Arsanuk… 263480b 
Yasir M. Arsanuk… 938d25c 


Yasir M. Arsanuk… 263480b 
Yasir M. Arsanuk… 938d25c 


Yasir M. Arsanuk… b871024 
Yasir M. Arsanuk… 938d25c 






















Yasir M. Arsanuk… 2432571 







Yasir M. Arsanuk… b871024 


Yasir M. Arsanuk… 2432571 
Yasir M. Arsanuk… b871024 


Yasir M. Arsanuk… 2432571 





Yasir M. Arsanuk… b871024 


Yasir M. Arsanuk… 2432571 




Yasir M. Arsanuk… b871024 
Yasir M. Arsanuk… 2432571 
Yasir M. Arsanuk… b871024 


Yasir M. Arsanuk… 2432571 



Yasir M. Arsanuk… 263480b 



Yasir M. Arsanuk… b871024 



Yasir M. Arsanuk… 938d25c 
Yasir M. Arsanuk… 2432571 











Yasir M. Arsanuk… b871024 







Yasir M. Arsanuk… 4475726 
#!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))))))))