syndicate-lang
/
syndicate-rkt
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Remove version; improve tests

This commit is contained in:
Tony Garnock-Jones 2018-09-25 15:53:35 +01:00
parent 240cee9d52
commit d0ff78e406
1 changed files with 40 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

57
syndicate/mc/preserve.rkt
View File

@ -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"
))
)