Remove version; improve tests
This commit is contained in:
parent
4cc83014d1
commit
7a5eec51bb
57
preserve.rkt
57
preserve.rkt
|
@ -26,14 +26,12 @@
|
|||
(define short-form-labels
|
||||
(make-parameter (vector 'discard 'capture 'observe)))
|
||||
|
||||
(define version 1)
|
||||
|
||||
(define (encode v)
|
||||
(bit-string->bytes (bit-string (version :: bits 8) (v :: (wire-value)))))
|
||||
(bit-string->bytes (bit-string (v :: (wire-value)))))
|
||||
|
||||
(define (decode bs [on-fail (lambda () (error 'decode "Invalid encoding: ~v" bs))])
|
||||
(bit-string-case bs
|
||||
([ (= version :: bits 8) (v :: (wire-value)) ] v)
|
||||
([ (v :: (wire-value)) ] v)
|
||||
(else (on-fail))))
|
||||
|
||||
(define-syntax wire-value
|
||||
|
@ -86,7 +84,7 @@
|
|||
(encode-end-byte major minor)))
|
||||
|
||||
(define (dict-keys-and-values d)
|
||||
(reverse (for/fold [(acc '())] [((k v) (in-dict d))] (cons k (cons v acc)))))
|
||||
(reverse (for/fold [(acc '())] [((k v) (in-dict d))] (cons v (cons k acc)))))
|
||||
|
||||
(define (short-form-for-label key)
|
||||
(let ((labels (short-form-labels)))
|
||||
|
@ -318,8 +316,19 @@
|
|||
#`(let ((loc #,(source-location->string #'forward)))
|
||||
(check-equal? (d (encode forward)) back loc)
|
||||
(check-equal? (d (encode back)) back loc)
|
||||
(check-equal? (d (expected version b ...)) back loc)
|
||||
(check-equal? (encode forward) (expected version b ...) loc)
|
||||
(check-equal? (d (expected b ...)) back loc)
|
||||
(check-equal? (encode forward) (expected b ...) loc)
|
||||
))))
|
||||
|
||||
(define-syntax (check-both-directions/nondeterministic stx)
|
||||
(syntax-case stx ()
|
||||
((_ v (b ...))
|
||||
#'(let ((val v)) (check-both-directions/nondeterministic v v (b ...))))
|
||||
((_ forward back (b ...))
|
||||
#`(let ((loc #,(source-location->string #'forward)))
|
||||
(check-equal? (d (encode forward)) back loc)
|
||||
(check-equal? (d (encode back)) back loc)
|
||||
(check-equal? (d (expected b ...)) back loc)
|
||||
))))
|
||||
|
||||
(check-both-directions (capture (discard)) (#x91 #x80))
|
||||
|
@ -375,16 +384,15 @@
|
|||
(check-both-directions 1.0 (#b00000011 #b00111111 #b11110000 0 0 0 0 0 0))
|
||||
(check-both-directions -1.202e300 (#x03 #xFE #x3C #xB7 #xB7 #x59 #xBF #x04 #x26))
|
||||
|
||||
(check-equal? (d (bytes (+ version 1) #x91 #x80)) (void))
|
||||
(check-equal? (d (expected version #x25 #x51 "a" #x35)) (void)) ;; Bad chunk type: must be bytes
|
||||
(check-equal? (d (expected version #x25 #x71 "a" #x35)) (void)) ;; Bad chunk type: must be bytes
|
||||
(check-equal? (d (expected version #x26 #x51 "a" #x36)) (void)) ;; Bad chunk type: must be bytes
|
||||
(check-equal? (d (expected version #x26 #x71 "a" #x36)) (void)) ;; Bad chunk type: must be bytes
|
||||
(check-equal? (d (expected version #x27 #x51 "a" #x37)) (void)) ;; Bad chunk type: must be bytes
|
||||
(check-equal? (d (expected version #x27 #x71 "a" #x37)) (void)) ;; Bad chunk type: must be bytes
|
||||
(check-equal? (d (expected version #x25 #x61 "a" #x35)) "a")
|
||||
(check-equal? (d (expected version #x26 #x61 "a" #x36)) #"a")
|
||||
(check-equal? (d (expected version #x27 #x61 "a" #x37)) 'a)
|
||||
(check-equal? (d (expected #x25 #x51 "a" #x35)) (void)) ;; Bad chunk type: must be bytes
|
||||
(check-equal? (d (expected #x25 #x71 "a" #x35)) (void)) ;; Bad chunk type: must be bytes
|
||||
(check-equal? (d (expected #x26 #x51 "a" #x36)) (void)) ;; Bad chunk type: must be bytes
|
||||
(check-equal? (d (expected #x26 #x71 "a" #x36)) (void)) ;; Bad chunk type: must be bytes
|
||||
(check-equal? (d (expected #x27 #x51 "a" #x37)) (void)) ;; Bad chunk type: must be bytes
|
||||
(check-equal? (d (expected #x27 #x71 "a" #x37)) (void)) ;; Bad chunk type: must be bytes
|
||||
(check-equal? (d (expected #x25 #x61 "a" #x35)) "a")
|
||||
(check-equal? (d (expected #x26 #x61 "a" #x36)) #"a")
|
||||
(check-equal? (d (expected #x27 #x61 "a" #x37)) 'a)
|
||||
|
||||
|
||||
(struct date (year month day) #:prefab)
|
||||
|
@ -421,4 +429,19 @@
|
|||
(#xB3 #x75 "other" #x71 "x" #x71 "y"))
|
||||
(check-both-directions (record "aString" '(3 4)) (#xB3 #x57 "aString" #x13 #x14))
|
||||
(check-both-directions (record (discard) '(3 4)) (#xB3 #x80 #x13 #x14))
|
||||
|
||||
(check-equal? (d (expected #x2C #x00 #x00)) (void)) ;; missing end byte
|
||||
(check-equal? (d (expected #xC3 #x00 #x00)) (void)) ;; missing element
|
||||
|
||||
(check-both-directions/nondeterministic
|
||||
(hash 'a 1
|
||||
"b" #t
|
||||
'(1 2 3) #"c"
|
||||
(hash 'first-name "Elizabeth") (hash 'surname "Blackwell"))
|
||||
(#xE8 #x71 "a" #x11
|
||||
#x51 "b" #x01
|
||||
#xC3 #x11 #x12 #x13 #x61 "c"
|
||||
#xE2 #x7A "first-name" #x59 "Elizabeth"
|
||||
#xE2 #x77 "surname" #x59 "Blackwell"
|
||||
))
|
||||
)
|
||||
|
|
Loading…
Reference in New Issue