From 672ee83be0d2ac337f3f078192c13ec707defa7b Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Sun, 11 Aug 2019 14:36:29 +0100 Subject: [PATCH] Begin factoring out test suite for cross-implementation use; begin updating Racket implementation to match (not finished) --- implementations/javascript/test/samples.txt | 48 -- implementations/racket/preserves/main.rkt | 584 ++++++++------------ implementations/racket/preserves/varint.rkt | 58 ++ tests/samples.txt | 216 ++++++++ 4 files changed, 518 insertions(+), 388 deletions(-) delete mode 100644 implementations/javascript/test/samples.txt create mode 100644 implementations/racket/preserves/varint.rkt create mode 100644 tests/samples.txt diff --git a/implementations/javascript/test/samples.txt b/implementations/javascript/test/samples.txt deleted file mode 100644 index 397b7ea..0000000 --- a/implementations/javascript/test/samples.txt +++ /dev/null @@ -1,48 +0,0 @@ -023f800000 -033ff0000000000000 -03fe3cb7b759bf0426 -10 -11 -1c -1d -1e -1f -25626865626c6c6060616f35 -25626865636c6c6f35 -26626865626c6c6060616f36 -27626865626c6c6060616f37 -2c111213143c -2c2563616263352563646566353c -2cc2516111c2516212c25163133c -410d -417f -4180 -4181 -41fc -420080 -4200ff -420100 -427fff -42feff -42ff00 -42ff01 -42ff02 -42ff7f -43008000 -4300ffff -43010000 -43020000 -5568656c6c6f -6568656c6c6f -7568656c6c6f -9180 -a1b375737065616b809180 -b5c5767469746c656476706572736f6e12757468696e6711416559426c61636b77656c6cb4746461746542071d1213524472 -c411121314 -c41e1f1011 -c75568656c6c6f75746865726565776f726c64c0d00100 -ce0000000000000000000000000000 -cf0f000000000000000000000000000000 -cf6400000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 -cfc8010000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 -e8716111516201c31112136163e27a66697273742d6e616d6559456c697a6162657468e2777375726e616d6559426c61636b77656c6c diff --git a/implementations/racket/preserves/main.rkt b/implementations/racket/preserves/main.rkt index 75a1410..d7651f7 100644 --- a/implementations/racket/preserves/main.rkt +++ b/implementations/racket/preserves/main.rkt @@ -3,12 +3,19 @@ (provide (struct-out stream-of) (struct-out record) - short-form-labels + (struct-out annotations) + (struct-out key-annotation) + (struct-out value-annotation) read-preserve + read-preserve/no-annotations string->preserve + string->preserve/no-annotations encode decode - wire-value) + wire-value + in-hash/annotations + in-set/annotations + in-list/annotations) (require racket/bytes) (require racket/dict) @@ -17,10 +24,22 @@ (require racket/set) (require bitsyntax) (require "struct.rkt") +(require "varint.rkt") (require (only-in syntax/readerr raise-read-error)) (struct stream-of (kind generator) #:transparent) +(struct annotations (here here-annotations links) #:transparent) +(struct key-annotation (key) #:transparent) +(struct value-annotation (key) #:transparent) + +(define empty-annotations (annotations '() (hash) (hash))) + +(define (empty-annotations? anns) + (and (null? (annotations-here anns)) + (hash-empty? (annotations-here-annotations anns)) + (hash-empty? (annotations-links anns)))) + (struct record (label fields) #:transparent) (define short-form-labels @@ -53,12 +72,6 @@ (bit-string (v :: bits 4)) (bit-string (#b1111 :: bits 4) ((encode-varint v) :: binary)))) -(define (encode-varint v) - (if (< v 128) - (bytes v) - (bit-string ((+ (modulo v 128) 128) :: bits 8) - ((encode-varint (quotient v 128)) :: binary)))) - (define (encode-array-like major minor fields) (bit-string (major :: bits 2) (minor :: bits 2) @@ -152,16 +165,6 @@ ([ (v :: bits 4) (rest :: binary) ] (ks v rest)) (else (kf)))) -(define (decode-varint bs ks kf) - (bit-string-case bs - #:on-short (lambda (fail) (kf #t)) - ([ (= 1 :: bits 1) (v :: bits 7) (rest :: binary) ] - (decode-varint rest (lambda (acc tail) (ks (+ (* acc 128) v) tail)) kf)) - ([ (= 0 :: bits 1) (v :: bits 7) (rest :: binary) ] - (ks v rest)) - (else - (kf)))) - (define (decode-values n acc-rev bs ks kf) (if (zero? n) (ks (reverse acc-rev) bs) @@ -264,10 +267,25 @@ pos #f)) -(define (read-preserve [i (current-input-port)]) +(define (read-preserve [i (current-input-port)] #:skip-annotations? [skip-annotations #f]) (local-require net/base64) (local-require file/sha1) + (define *here-annotations* '()) + (define *here-annotation-annotations* '()) + (define *child-annotations* (hash)) + + (define (push-here-annotation! a aa v) + (unless skip-annotations + (set! *here-annotations* (cons a *here-annotations*)) + (set! *here-annotation-annotations* (cons aa *here-annotation-annotations*))) + v) + + (define (push-child-annotation! k aa) + (unless skip-annotations + (unless (empty-annotations? aa) + (set! *child-annotations* (hash-set *child-annotations* k aa))))) + (define-match-expander px (syntax-rules () [(_ re pat) (app (lambda (v) (regexp-try-match re v)) pat)])) @@ -275,10 +293,10 @@ (define (parse-error fmt . args) (apply parse-error* i fmt args)) - (define (eof-guard ch) - (match ch + (define (eof-guard v) + (match v [(? eof-object?) (parse-error "Unexpected end of input")] - [ch ch])) + [v v])) (define (peek/no-eof) (eof-guard (peek-char i))) (define (read/no-eof) (eof-guard (read-char i))) @@ -286,21 +304,26 @@ (define (skip-whitespace) (skip-whitespace* i)) (define (read-sequence terminator) - (sequence-fold '() (lambda (acc) (cons (read-value) acc)) reverse terminator)) + (define i 0) + (define (next-key _acc _v) (begin0 i (set! i (+ i 1)))) + (sequence-fold '() (lambda (acc v) (cons v acc)) next-key reverse terminator)) (define (read-dictionary-or-set seed) (sequence-fold seed - (lambda (acc) - (define k (read-value)) + (lambda (acc k) (skip-whitespace) (match (peek-char i) [#\: (read-char i) - (when (set? acc) - (parse-error "Unexpected key/value separator in set")) - (define v (read-value)) + (when (set? acc) (parse-error "Unexpected key/value separator in set")) + (define-values (v v-anns) (read-value/annotations)) + (push-child-annotation! (value-annotation k) v-anns) (hash-set (or acc (hash)) k v)] [_ (when (hash? acc) (parse-error "Missing expected key/value separator")) (set-add (or acc (set)) k)])) + (lambda (new-acc k) + (if (hash? new-acc) + (key-annotation k) + k)) (lambda (acc) (or acc (hash))) #\})) @@ -446,12 +469,15 @@ [#\- (read-intpart (list (read-char i)))] [_ (read-intpart (list))])) - (define (sequence-fold acc accumulate-one finish terminator-char) + (define (sequence-fold acc accumulate-one compute-key finish terminator-char) (let loop ((acc acc)) (skip-whitespace) (match (peek/no-eof) [(== terminator-char) (read-char i) (finish acc)] - [_ (loop (accumulate-one acc))]))) + [_ (define-values (next next-anns) (read-value/annotations)) + (define new-acc (accumulate-one acc next)) + (push-child-annotation! (compute-key acc next) next-anns) + (loop new-acc)]))) (define (collect-fields head) (match (peek-char i) @@ -463,6 +489,27 @@ (collect-fields (build-record head (list (read-dictionary-or-set (hash)))))] [_ head])) + (define (read-value/annotations) + (if skip-annotations + (values (eof-guard (read-value)) empty-annotations) + (let ((old-here-annotations *here-annotations*) + (old-here-annotation-annotations *here-annotation-annotations*) + (old-child-annotations *child-annotations*)) + (set! *here-annotations* '()) + (set! *here-annotation-annotations* '()) + (set! *child-annotations* (hash)) + (let* ((v (eof-guard (read-value))) + (a (annotations *here-annotations* + (for/hash [(i (in-naturals)) + (aa (in-list *here-annotation-annotations*)) + #:when (not (empty-annotations? aa))] + (values i aa)) + *child-annotations*))) + (set! *here-annotations* old-here-annotations) + (set! *here-annotation-annotations* old-here-annotation-annotations) + (set! *child-annotations* old-child-annotations) + (values v a))))) + (define (read-value) (skip-whitespace) (collect-fields @@ -473,12 +520,18 @@ [(or #\- #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9) (read-number)] [#\" (read-char i) (read-string #\")] [(== PIPE) (read-char i) (string->symbol (read-string PIPE))] + [#\@ (read-char i) + (define-values (a aa) (read-value/annotations)) + (define v (eof-guard (read-value))) + (push-here-annotation! a aa v)] [#\# (match i [(px #px#"^#set\\{" (list _)) - (sequence-fold (set) (lambda (acc) (set-add acc (read-value))) values #\})] + (sequence-fold (set) set-add (lambda (acc v) v) values #\})] [(px #px#"^#value" (list _)) - (define bs (read-value)) + (define-values (bs anns) (read-value/annotations)) (when (not (bytes? bs)) (parse-error "ByteString must follow #value")) + (when (not (empty-annotations? anns)) + (parse-error "Annotations not permitted after #value")) (decode bs)] [(px #px#"^#true" (list _)) #t] @@ -496,49 +549,82 @@ [#\: (read-char i) (parse-error "Unexpected key/value separator between items")] [_ (read-raw-symbol '())]))) - (read-value)) + (read-value/annotations)) -(define (string->preserve s) +(define (read-preserve/no-annotations [i (current-input-port)]) + (define-values (v _v-anns) (read-preserve i #:skip-annotations? #t)) + v) + +(define (string->preserve s #:skip-annotations? [skip-annotations #f]) (define p (open-input-string s)) - (define v (read-preserve p)) + (define-values (v v-anns) (read-preserve p #:skip-annotations? skip-annotations)) (when (eof-object? v) (parse-error* p "Unexpected end of input")) (skip-whitespace* p) (when (not (eof-object? (peek-char p))) (parse-error* p "Unexpected text following preserve")) + (values v v-anns)) + +(define (string->preserve/no-annotations s) + (define-values (v _v-anns) (string->preserve s #:skip-annotations? #t)) v) ;;--------------------------------------------------------------------------- +(define (in-hash/annotations h h-anns) + (define links (annotations-links h-anns)) + (make-do-sequence (lambda () + (values + (lambda (pos) + (define-values (k v) (hash-iterate-key+value h pos)) + (define k-anns (hash-ref links (key-annotation k) empty-annotations)) + (define v-anns (hash-ref links (value-annotation k) empty-annotations)) + (values k k-anns v v-anns)) + (lambda (pos) + (hash-iterate-next h pos)) + (hash-iterate-first h) + values + #f + #f)))) + +(define (in-set/annotations s s-anns) + (define links (annotations-links s-anns)) + (make-do-sequence (lambda () + (values + (lambda (xs) + (define x (car xs)) + (define x-anns (hash-ref links x empty-annotations)) + (values x x-anns)) + cdr + (set->list s) + pair? + #f + #f)))) + +(define (in-list/annotations xs xs-anns) + (define links (annotations-links xs-anns)) + (make-do-sequence (lambda () + (define i 0) + (values + (lambda (xs) + (define x (car xs)) + (define x-anns (hash-ref links + (begin0 i (set! i (+ i 1))) + empty-annotations)) + (values x x-anns)) + cdr + xs + pair? + #f + #f)))) + +;;--------------------------------------------------------------------------- + (module+ test (require rackunit) + (require racket/runtime-path) (require (for-syntax racket syntax/srcloc)) - (check-equal? (bit-string->bytes (encode-varint 0)) (bytes 0)) - (check-equal? (bit-string->bytes (encode-varint 1)) (bytes 1)) - (check-equal? (bit-string->bytes (encode-varint 127)) (bytes 127)) - (check-equal? (bit-string->bytes (encode-varint 128)) (bytes 128 1)) - (check-equal? (bit-string->bytes (encode-varint 255)) (bytes 255 1)) - (check-equal? (bit-string->bytes (encode-varint 256)) (bytes 128 2)) - (check-equal? (bit-string->bytes (encode-varint 300)) (bytes #b10101100 #b00000010)) - (check-equal? (bit-string->bytes (encode-varint 1000000000)) (bytes 128 148 235 220 3)) - - (define (ks* v rest) (list v (bit-string->bytes rest))) - (define (kf* [short? #f]) (if short? 'short (void))) - - (check-equal? (decode-varint (bytes 0) ks* kf*) (list 0 (bytes))) - (check-equal? (decode-varint (bytes 0 99) ks* kf*) (list 0 (bytes 99))) - (check-equal? (decode-varint (bytes 1) ks* kf*) (list 1 (bytes))) - (check-equal? (decode-varint (bytes 127) ks* kf*) (list 127 (bytes))) - (check-equal? (decode-varint (bytes 128) ks* kf*) 'short) - (check-equal? (decode-varint (bytes 128 1) ks* kf*) (list 128 (bytes))) - (check-equal? (decode-varint (bytes 128 1 99) ks* kf*) (list 128 (bytes 99))) - (check-equal? (decode-varint (bytes 255 1) ks* kf*) (list 255 (bytes))) - (check-equal? (decode-varint (bytes 128 2) ks* kf*) (list 256 (bytes))) - (check-equal? (decode-varint (bytes #b10101100 #b00000010) ks* kf*) (list 300 (bytes))) - (check-equal? (decode-varint (bytes 128 148 235 220 3) ks* kf*) (list 1000000000 (bytes))) - (check-equal? (decode-varint (bytes 128 148 235 220 3 99) ks* kf*) (list 1000000000 (bytes 99))) - (check-equal? (bit-string->bytes (bit-string (0 :: bits 4) (0 :: (wire-length)))) (bytes 0)) (check-equal? (bit-string->bytes (bit-string (0 :: bits 4) (3 :: (wire-length)))) (bytes 3)) (check-equal? (bit-string->bytes (bit-string (0 :: bits 4) (14 :: (wire-length)))) (bytes 14)) @@ -564,17 +650,6 @@ (check-equal? (dwl (bytes 15 #b10101100 #b00000010)) 300) (check-equal? (dwl (bytes 15 #b10101100)) 'short) - (struct speak (who what) #:prefab) - - (define (expected . pieces) - (bit-string->bytes - (apply bit-string-append - (map (match-lambda - [(? byte? b) (bytes b)] - [(? bytes? bs) bs] - [(? string? s) (string->bytes/utf-8 s)]) - pieces)))) - (define (d bs) (for [(i (in-range 0 (- (bytes-length bs) 1)))] (when (not (eq? (decode (subbytes bs 0 i) @@ -615,281 +690,110 @@ (struct capture (detail) #:prefab) (struct observe (specification) #:prefab) - (cross-check "capture(discard())" (capture (discard)) (#x91 #x80)) - (cross-check "observe(speak(discard(), capture(discard())))" - (observe (speak (discard) (capture (discard)))) - (#xA1 #xB3 #x75 "speak" #x80 #x91 #x80)) - (cross-check "[1, 2, 3, 4]" '(1 2 3 4) (#xC4 #x11 #x12 #x13 #x14)) - (cross-check "[1 2 3 4]" - (stream-of 'sequence (sequence->generator '(1 2 3 4))) - '(1 2 3 4) - (#x2C #x11 #x12 #x13 #x14 #x3C)) - (cross-check " [ -2 -1 0 1 ] " '(-2 -1 0 1) (#xC4 #x1E #x1F #x10 #x11)) - (cross-check "\"hello\"" "hello" (#x55 "hello")) - (cross-check "\"hello\"" - (stream-of 'string (sequence->generator '(#"he" #"llo"))) - "hello" - (#x25 #x62 "he" #x63 "llo" #x35)) - (cross-check "\"hello\"" - (stream-of 'string (sequence->generator '(#"he" #"ll" #"" #"" #"o"))) - "hello" - (#x25 #x62 "he" #x62 "ll" #x60 #x60 #x61 "o" #x35)) - (cross-check "#\"hello\"" - (stream-of 'byte-string (sequence->generator '(#"he" #"ll" #"" #"" #"o"))) - #"hello" - (#x26 #x62 "he" #x62 "ll" #x60 #x60 #x61 "o" #x36)) - (cross-check "hello" - (stream-of 'symbol (sequence->generator '(#"he" #"ll" #"" #"" #"o"))) - 'hello - (#x27 #x62 "he" #x62 "ll" #x60 #x60 #x61 "o" #x37)) - (cross-check "[\"hello\" there #\"world\" [] #set{} #true #false]" - `("hello" there #"world" () ,(set) #t #f) - (#xC7 #x55 "hello" #x75 "there" #x65 "world" #xC0 #xD0 #x01 #x00)) - - (cross-check "#\"ABC\"" #"ABC" (#x63 #x41 #x42 #x43)) - (cross-check "#hex{414243}" #"ABC" (#x63 #x41 #x42 #x43)) - (cross-check "#hex{ 41 4A 4e }" #"AJN" (#x63 #x41 #x4A #x4E)) - ;; No comments: (cross-check "#hex{ 41;re\n 42 43 }" #"ABC" (#x63 #x41 #x42 #x43)) - (check-exn exn? (lambda () (string->preserve "#hex{414 243}"))) ;; bytes must be 2-digits entire - (cross-check "#base64{Y29yeW1i}" #"corymb" (#x66 "corymb")) - (cross-check "#base64{Y29 yeW 1i}" #"corymb" (#x66 "corymb")) - ;; No comments: (cross-check ";; a comment\n#base64{\n;x\nY29 yeW 1i}" #"corymb" (#x66 "corymb")) - (cross-check "#base64{SGk=}" #"Hi" (#x62 "Hi")) - (cross-check "#base64{SGk}" #"Hi" (#x62 "Hi")) - (cross-check "#base64{ S G k }" #"Hi" (#x62 "Hi")) - - (cross-check "#value#\"fcorymb\"" #"corymb" (#x66 "corymb")) - (cross-check "#value#\"\x01\"" #t (#x01)) - (cross-check "#value#base64{AQ}" #t (#x01)) - (cross-check "#value#base64{AQ==}" #t (#x01)) - (cross-check "#value #base64{AQ==}" #t (#x01)) - ;; No comments: (cross-check "#value ;;comment\n #base64{AQ==}" #t (#x01)) - - (check-equal? (string->preserve "[]") '()) - (check-equal? (string->preserve "{}") (hash)) - (check-equal? (string->preserve "\"\"") "") - (check-equal? (string->preserve "||") (string->symbol "")) - (check-equal? (string->preserve "#set{}") (set)) - - (check-equal? (string->preserve "{1 2 3}") (set 1 2 3)) - (check-equal? (string->preserve "#set{1 2 3}") (set 1 2 3)) - - (cross-check "\"abc\\u6c34\\u6C34\\\\\\/\\\"\\b\\f\\n\\r\\txyz\"" - "abc\u6c34\u6c34\\/\"\b\f\n\r\txyz" - (#x5f #x14 - #x61 #x62 #x63 #xe6 #xb0 #xb4 #xe6 #xb0 - #xb4 #x5c #x2f #x22 #x08 #x0c #x0a #x0d - #x09 #x78 #x79 #x7a)) - - (cross-check "|abc\\u6c34\\u6C34\\\\\\/\\|\\b\\f\\n\\r\\txyz|" - (string->symbol "abc\u6c34\u6c34\\/|\b\f\n\r\txyz") - (#x7f #x14 - #x61 #x62 #x63 #xe6 #xb0 #xb4 #xe6 #xb0 - #xb4 #x5c #x2f #x7c #x08 #x0c #x0a #x0d - #x09 #x78 #x79 #x7a)) - - (check-exn #px"Invalid escape code \\\\u" (lambda () (string->preserve "#\"\\u6c34\""))) - - (cross-check "#\"abc\\x6c\\x34\\xf0\\\\\\/\\\"\\b\\f\\n\\r\\txyz\"" - #"abc\x6c\x34\xf0\\/\"\b\f\n\r\txyz" - (#x6f #x11 - #x61 #x62 #x63 #x6c #x34 #xf0 #x5c #x2f - #x22 #x08 #x0c #x0a #x0d #x09 #x78 #x79 #x7a)) - - (cross-check "\"\\uD834\\uDD1E\"" "\U0001D11E" (#x54 #xF0 #x9D #x84 #x9E)) - - (cross-check "-257" -257 (#x42 #xFE #xFF)) - (cross-check "-256" -256 (#x42 #xFF #x00)) - (cross-check "-255" -255 (#x42 #xFF #x01)) - (cross-check "-254" -254 (#x42 #xFF #x02)) - (cross-check "-129" -129 (#x42 #xFF #x7F)) - (cross-check "-128" -128 (#x41 #x80)) - (cross-check "-127" -127 (#x41 #x81)) - (cross-check "-4" -4 (#x41 #xFC)) - (cross-check "-3" -3 (#x1D)) - (cross-check "-2" -2 (#x1E)) - (cross-check "-1" -1 (#x1F)) - (cross-check "0" 0 (#x10)) - (cross-check "1" 1 (#x11)) - (cross-check "12" 12 (#x1C)) - (cross-check "13" 13 (#x41 #x0D)) - (cross-check "127" 127 (#x41 #x7F)) - (cross-check "128" 128 (#x42 #x00 #x80)) - (cross-check "255" 255 (#x42 #x00 #xFF)) - (cross-check "256" 256 (#x42 #x01 #x00)) - (cross-check "32767" 32767 (#x42 #x7F #xFF)) - (cross-check "32768" 32768 (#x43 #x00 #x80 #x00)) - (cross-check "65535" 65535 (#x43 #x00 #xFF #xFF)) - (cross-check "65536" 65536 (#x43 #x01 #x00 #x00)) - (cross-check "131072" 131072 (#x43 #x02 #x00 #x00)) - - (cross-check "1.0f" 1.0f0 (#b00000010 #b00111111 #b10000000 0 0)) - (cross-check "1.0" 1.0 (#b00000011 #b00111111 #b11110000 0 0 0 0 0 0)) - (cross-check "-1.202e300" -1.202e300 (#x03 #xFE #x3C #xB7 #xB7 #x59 #xBF #x04 #x26)) - - (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) - - (cross-check "[\"a\"\"b\"]" (list "a" "b") (#xC2 #x51 #x61 #x51 #x62)) + (struct speak (who what) #:prefab) (struct date (year month day) #:prefab) (struct thing (id) #:prefab) (struct person thing (name date-of-birth) #:prefab) (struct titled person (title) #:prefab) - (cross-check - "[titled person 2 thing 1](101, \"Blackwell\", date(1821 2 3), \"Dr\")" - (titled 101 "Blackwell" (date 1821 2 3) "Dr") - (#xB5 ;; Record, generic, 4+1 - #xC5 ;; Sequence, 5 - #x76 #x74 #x69 #x74 #x6C #x65 #x64 ;; Symbol, "titled" - #x76 #x70 #x65 #x72 #x73 #x6F #x6E ;; Symbol, "person" - #x12 ;; SignedInteger, "2" - #x75 #x74 #x68 #x69 #x6E #x67 ;; Symbol, "thing" - #x11 ;; SignedInteger, "1" - #x41 #x65 ;; SignedInteger, "101" - #x59 #x42 #x6C #x61 #x63 #x6B #x77 #x65 #x6C #x6C ;; String, "Blackwell" - #xB4 ;; Record, generic, 3+1 - #x74 #x64 #x61 #x74 #x65 ;; Symbol, "date" - #x42 #x07 #x1D ;; SignedInteger, "1821" - #x12 ;; SignedInteger, "2" - #x13 ;; SignedInteger, "3" - #x52 #x44 #x72 ;; String, "Dr" - )) + (struct asymmetric (forward back)) + (struct nondeterministic (value)) - (cross-check "discard()" (record 'discard '()) (discard) (#x80)) - (cross-check "discard(surprise)" - (record 'discard '(surprise)) - '#s(discard surprise) - (#x81 #x78 "surprise")) - (cross-check "capture(x)" (record 'capture '(x)) (capture 'x) (#x91 #x71 "x")) - (cross-check "observe(x)" (record 'observe '(x)) (observe 'x) (#xA1 #x71 "x")) - (cross-check "observe(x y)" (record 'observe '(x y)) '#s(observe x y) (#xA2 #x71 "x" #x71 "y")) - (cross-check "other(x y)" - (record 'other '(x y)) - '#s(other x y) - (#xB3 #x75 "other" #x71 "x" #x71 "y")) - (cross-check "\"aString\"(3 4)" - (record "aString" '(3 4)) - (#xB3 #x57 "aString" #x13 #x14)) - (cross-check "discard()(3, 4)" - (record (discard) '(3 4)) - (#xB3 #x80 #x13 #x14)) - - (cross-check "[abc ... def]" (list 'abc '|...| 'def) (#xC3 #x73 "abc" #x73 "..." #x73 "def")) - - (check-equal? (d (expected #x2C #x00 #x00)) 'short) ;; missing end byte - (check-equal? (d (expected #xC3 #x00 #x00)) 'short) ;; missing element - - (cross-check/nondeterministic - "{a: 1, \"b\": #true, [1 2 3]: #\"c\", {first-name:\"Elizabeth\"}:{surname:\"Blackwell\"}}" - (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" - )) - - (let () - (local-require json) - (define rfc8259-example1 (string->preserve #<preserve #<generator '(1 2 3 4))) + '(1 2 3 4)) + 'list5 '(-2 -1 0 1) + 'string3 "hello" + 'string2 (asymmetric (stream-of 'string (sequence->generator '(#"he" #"llo"))) + "hello") + 'string1 (asymmetric (stream-of 'string (sequence->generator '(#"he" #"ll" #"" #"" #"o"))) + "hello") + 'bytes1 (asymmetric (stream-of 'byte-string (sequence->generator '(#"he" #"ll" #"" #"" #"o"))) + #"hello") + 'symbol1 (asymmetric (stream-of 'symbol (sequence->generator '(#"he" #"ll" #"" #"" #"o"))) + 'hello) + 'list6 `("hello" there #"world" () ,(set) #t #f) + 'bytes2 #"hello" + 'bytes3 #"ABC" + 'bytes4 #"ABC" + 'bytes5 #"AJN" + 'bytes7 #"corymb" + 'bytes8 #"corymb" + 'bytes9 #"Hi" + 'bytes10 #"Hi" + 'bytes11 #"Hi" + 'value1 #"corymb" + 'value2 #t + 'value3 #t + 'value4 #t + 'value5 #t + 'list0 '() + 'dict0 (hash) + 'string0 "" + 'string0a (asymmetric (stream-of 'string (sequence->generator '())) + "") + 'symbol0 '|| + 'set0 (set) + 'set1 (set 1 2 3) + 'set1a (set 1 2 3) + 'string4 "abc\u6c34\u6C34\\/\"\b\f\n\r\txyz" + 'bytes13 #"abc\x6c\x34\xf0\\/\"\b\f\n\r\txyz" + 'string5 "\U0001D11E" + 'list2 '("abc" "def") + 'record1 (capture (discard)) + 'record2 (observe (speak (discard) (capture (discard)))) + 'record3 (titled 101 "Blackwell" (date 1821 2 3) "Dr") + 'record4 (asymmetric (record 'discard '()) (discard)) + 'record5 (record 7 '(())) + 'record6 (asymmetric (record 'discard '(surprise)) + '#s(discard surprise)) + 'recurd7 (record "aString" '(3 4)) + 'record8 (record (discard) '(3 4)) + 'list7 (list 'abc '|...| 'def) + 'dict1 (hash 'a 1 + "b" #t + '(1 2 3) #"c" + (hash 'first-name "Elizabeth") (hash 'surname "Blackwell")) + 'rfc8259-example1 (nondeterministic + (hash "Image" + (hash "Width" 800 + "Height" 600 + "Title" "View from 15th Floor" + "Thumbnail" (hash "Url" "http://www.example.com/image/481989943" + "Height" 125 + "Width" 100) + "Animated" #f + "IDs" (list 116 943 234 38793)))) + 'rfc8259-example2 (nondeterministic + (list (hash + "precision" "zip" + "Latitude" 37.7668 + "Longitude" -122.3959 + "Address" "" + "City" "SAN FRANCISCO" + "State" "CA" + "Zip" "94107" + "Country" "US") + (hash + "precision" "zip" + "Latitude" 37.371991 + "Longitude" -122.026020 + "Address" "" + "City" "SUNNYVALE" + "State" "CA" + "Zip" "94085" + "Country" "US"))) )) - ) + + (define-runtime-path tests-path "../../../tests") + (let-values (((tests test-annotations) + (with-input-from-file (build-path tests-path "samples.txt") + read-preserve))) + (local-require racket/pretty) + (for [((t-name _t-name-anns t t-anns) (in-hash/annotations tests test-annotations))] + (pretty-print (list t-name t t-anns)))) ) diff --git a/implementations/racket/preserves/varint.rkt b/implementations/racket/preserves/varint.rkt new file mode 100644 index 0000000..6d1403a --- /dev/null +++ b/implementations/racket/preserves/varint.rkt @@ -0,0 +1,58 @@ +#lang racket/base +;; "varints" from Google Protocol Buffers, +;; https://developers.google.com/protocol-buffers/docs/encoding#varints +;; +;; "Each byte in a varint, except the last byte, has the most +;; significant bit (msb) set – this indicates that there are further +;; bytes to come. The lower 7 bits of each byte are used to store the +;; two's complement representation of the number in groups of 7 bits, +;; least significant group first." + +(provide encode-varint + decode-varint) + +(require bitsyntax) + +(define (encode-varint v) + (if (< v 128) + (bytes v) + (bit-string ((+ (modulo v 128) 128) :: bits 8) + ((encode-varint (quotient v 128)) :: binary)))) + +(define (decode-varint bs ks kf) + (bit-string-case bs + #:on-short (lambda (fail) (kf #t)) + ([ (= 1 :: bits 1) (v :: bits 7) (rest :: binary) ] + (decode-varint rest (lambda (acc tail) (ks (+ (* acc 128) v) tail)) kf)) + ([ (= 0 :: bits 1) (v :: bits 7) (rest :: binary) ] + (ks v rest)) + (else + (kf)))) + +(module+ test + (require rackunit) + + (check-equal? (bit-string->bytes (encode-varint 0)) (bytes 0)) + (check-equal? (bit-string->bytes (encode-varint 1)) (bytes 1)) + (check-equal? (bit-string->bytes (encode-varint 127)) (bytes 127)) + (check-equal? (bit-string->bytes (encode-varint 128)) (bytes 128 1)) + (check-equal? (bit-string->bytes (encode-varint 255)) (bytes 255 1)) + (check-equal? (bit-string->bytes (encode-varint 256)) (bytes 128 2)) + (check-equal? (bit-string->bytes (encode-varint 300)) (bytes #b10101100 #b00000010)) + (check-equal? (bit-string->bytes (encode-varint 1000000000)) (bytes 128 148 235 220 3)) + + (define (ks* v rest) (list v (bit-string->bytes rest))) + (define (kf* [short? #f]) (if short? 'short (void))) + + (check-equal? (decode-varint (bytes 0) ks* kf*) (list 0 (bytes))) + (check-equal? (decode-varint (bytes 0 99) ks* kf*) (list 0 (bytes 99))) + (check-equal? (decode-varint (bytes 1) ks* kf*) (list 1 (bytes))) + (check-equal? (decode-varint (bytes 127) ks* kf*) (list 127 (bytes))) + (check-equal? (decode-varint (bytes 128) ks* kf*) 'short) + (check-equal? (decode-varint (bytes 128 1) ks* kf*) (list 128 (bytes))) + (check-equal? (decode-varint (bytes 128 1 99) ks* kf*) (list 128 (bytes 99))) + (check-equal? (decode-varint (bytes 255 1) ks* kf*) (list 255 (bytes))) + (check-equal? (decode-varint (bytes 128 2) ks* kf*) (list 256 (bytes))) + (check-equal? (decode-varint (bytes #b10101100 #b00000010) ks* kf*) (list 300 (bytes))) + (check-equal? (decode-varint (bytes 128 148 235 220 3) ks* kf*) (list 1000000000 (bytes))) + (check-equal? (decode-varint (bytes 128 148 235 220 3 99) ks* kf*) (list 1000000000 (bytes 99)))) diff --git a/tests/samples.txt b/tests/samples.txt new file mode 100644 index 0000000..9db736f --- /dev/null +++ b/tests/samples.txt @@ -0,0 +1,216 @@ +@EmacsMode("-*- preserves -*-") +@"Expects placeholder mapping of:" +@"{ 0: discard, 1: capture, 2: observe }" +{ + annotation1: Test(#hex{055361626339} @"abc" 9) + annotation2: Test(#hex{05536162630553646566929005517890} @"abc" @"def" [[] @"x" []]) + annotation3: Test(#hex{050531320505333435} @@1 2 @@3 4 5) + annotation4: Test(#hex{b4 05 72616b 7161 05 726176 31 05 72626b 7162 05 726276 32} + {@ak a: @av 1 @bk b: @bv 2}) + annotation5: @"AMBIGUOUS! Should `ar` attach to `R` or `R(...)`?" Test(#hex{} @ar R(@af f)) + bytes1: Test(#hex{26626865626c6c616f04} #"hello") + bytes2: Test(#hex{6568656c6c6f} #"hello") + bytes3: Test(#hex{63414243} #"ABC") + bytes4: Test(#hex{63414243} #hex{414243}) + bytes5: Test(#hex{63414a4e} #hex{ 41 4A 4e }) + bytes6: @"Bytes must be 2-digits entire" ParseError("#hex{414 243}") + bytes7: Test(#"\x66corymb" #base64{Y29yeW1i}) + bytes8: Test(#"\x66corymb" #base64{Y29 yeW 1i}) + bytes9: Test(#"\x62Hi" #base64{SGk=}) + bytes10: Test(#"\x62Hi" #base64{SGk}) + bytes11: Test(#"\x62Hi" #base64{S G k}) + bytes12: @"Bytes syntax only supports \\x, not \\u" ParseError("#\"\\u6c34\"") + bytes13: Test(#hex{6f 11 61 62 63 6c 34 f0 5c 2f 22 08 0c 0a 0d 09 78 79 7a} #"abc\x6c\x34\xf0\\/\"\b\f\n\r\txyz") + + dict0: Test(#hex{b0} {}) + dict1: Test(#hex{b8 7161 31 5162 01 93313233 6163 b2 7a66697273742d6e616d65 59456c697a6162657468 b2 777375726e616d65 59426c61636b77656c6c} { a: 1 "b": #true [1 2 3]: c { first-name: "Elizabeth" }: { surname: "Blackwell" } }) + double1: Test(#hex{033ff0000000000000} 1.0) + double2: Test(#hex{03fe3cb7b759bf0426} -1.202e300) + float1: Test(#hex{023f800000} 1.0f) + int-257: Test(#hex{42feff} -257) + int-256: Test(#hex{42ff00} -256) + int-255: Test(#hex{42ff01} -255) + int-254: Test(#hex{42ff02} -254) + int-129: Test(#hex{42ff7f} -129) + int-128: Test(#hex{4180} -128) + int-127: Test(#hex{4181} -127) + int-4: Test(#hex{41fc} -4) + int-3: Test(#hex{3d} -3) + int-2: Test(#hex{3e} -2) + int-1: Test(#hex{3f} -1) + int0: Test(#hex{30} 0) + int1: Test(#hex{31} 1) + int12: Test(#hex{3c} 12) + int13: Test(#hex{410d} 13) + int127: Test(#hex{417f} 127) + int128: Test(#hex{420080} 128) + int255: Test(#hex{4200ff} 255) + int256: Test(#hex{420100} 256) + int32767: Test(#hex{427fff} 32767) + int32768: Test(#hex{43008000} 32768) + int65535: Test(#hex{4300ffff} 65535) + int65536: Test(#hex{43010000} 65536) + int131072: Test(#hex{43020000} 131072) + list0: Test(#hex{90} []) + list1: Test(#hex{293132333404} [1 2 3 4]) + list2: Test(#hex{2925636162630425636465660404} ["abc" "def"]) + list3: Test(#hex{2992516131925162329251633304} [["a" 1] ["b" 2] ["c" 3]]) + list4: Test(#hex{9431323334} [1 2 3 4]) + list4a: Test(#hex{9431323334} [1, 2, 3, 4]) + list5: Test(#hex{943e3f3031} [-2 -1 0 1]) + list6: Test(#hex{97 5568656c6c6f 757468657265 65776f726c64 90 a0 01 00} ["hello" #"there" world [] #set{} #true #false]) + list7: Test(#hex{93 73616263 732e2e2e 73646566} [abc ... def]) + placeholder0: Test(#hex{10} discard) + placeholder1: Test(#hex{11} capture) + placeholder2: Test(#hex{12} observe) + record1: Test(#hex{82118110} capture(discard())) + record2: Test(#hex{82 12 83 75737065616b 81 10 82 11 81 10} observe(speak(discard(), capture(discard())))) + record3: Test(#hex{85 95 767469746c6564 76706572736f6e 32 757468696e67 31 4165 59426c61636b77656c6c 84 7464617465 42071d 32 33 524472} [titled person 2 thing 1](101 "Blackwell" date(1821 2 3) "Dr")) + record4: Test(#hex{8110} discard()) + record5: Test(#hex{823790} 7[]) + record6: Test(#hex{8210787375727072697365} discard(surprise)) + record7: Test(#hex{835761537472696e673334} "aString"(3 4)) + record8: Test(#hex{8381103334} discard()(3, 4)) + set0: Test(#hex{a0} #set{}) + set1: Test(#hex{a3313233} {1 2 3}) + set1a: Test(#hex{a3313233} #set{1 2 3}) + stream1: @"Chunk must be bytes" DecodeError(#hex{25516104}) + stream2: @"Chunk must be bytes" DecodeError(#hex{25716104}) + stream3: @"Chunk must be bytes" DecodeError(#hex{26516104}) + stream4: @"Chunk must be bytes" DecodeError(#hex{26716104}) + stream5: @"Chunk must be bytes" DecodeError(#hex{27516104}) + stream6: @"Chunk must be bytes" DecodeError(#hex{27716104}) + stream7: @"Missing end byte" DecodeShort(#hex{290000}) + stream8: @"Missing element" DecodeShort(#hex{930000}) + string0: Test(#hex{50} "") + string0a: Test(#hex{2504} "") + string1: Test(#hex{25626865626c6c616f04} "hello") + string2: Test(#hex{25626865636c6c6f04} "hello") + string3: Test(#hex{5568656c6c6f} "hello") + string4: Test(#hex{5f 14 616263e6b0b4e6b0b45c2f22080c0a0d0978797a} "abc\u6c34\u6C34\\/\"\b\f\n\r\txyz") + string5: Test(#hex{54f09d849e} "\uD834\uDD1E") + symbol0: Test(#hex{70} ||) + symbol1: Test(#hex{27626865626c6c616f04} hello) + symbol2: Test(#hex{7568656c6c6f} hello) + value1: Test(#"\x66corymb" #value#"fcorymb") + value2: Test(#"\x01" #value#"\x01") + value3: Test(#"\x01" #value#base64{AQ}) + value4: Test(#"\x01" #value#base64{AQ==}) + value5: Test(#"\x01" #value #base64{AQ==}) + + longlist14: Test(#hex{9e0000000000000000000000000000} + [#false #false #false #false #false + #false #false #false #false #false + #false #false #false #false]) + longlist15: Test(#hex{9f0f000000000000000000000000000000} + [#false #false #false #false #false + #false #false #false #false #false + #false #false #false #false #false]) + longlist100: + Test(#hex{9f64 + 00000000000000000000 + 00000000000000000000 + 00000000000000000000 + 00000000000000000000 + 00000000000000000000 + 00000000000000000000 + 00000000000000000000 + 00000000000000000000 + 00000000000000000000 + 00000000000000000000} + [#false #false #false #false #false #false #false #false #false #false + #false #false #false #false #false #false #false #false #false #false + #false #false #false #false #false #false #false #false #false #false + #false #false #false #false #false #false #false #false #false #false + #false #false #false #false #false #false #false #false #false #false + #false #false #false #false #false #false #false #false #false #false + #false #false #false #false #false #false #false #false #false #false + #false #false #false #false #false #false #false #false #false #false + #false #false #false #false #false #false #false #false #false #false + #false #false #false #false #false #false #false #false #false #false]) + longlist200: + Test(#hex{9fc801 + 00000000000000000000 + 00000000000000000000 + 00000000000000000000 + 00000000000000000000 + 00000000000000000000 + 00000000000000000000 + 00000000000000000000 + 00000000000000000000 + 00000000000000000000 + 00000000000000000000 + 00000000000000000000 + 00000000000000000000 + 00000000000000000000 + 00000000000000000000 + 00000000000000000000 + 00000000000000000000 + 00000000000000000000 + 00000000000000000000 + 00000000000000000000 + 00000000000000000000} + [#false #false #false #false #false #false #false #false #false #false + #false #false #false #false #false #false #false #false #false #false + #false #false #false #false #false #false #false #false #false #false + #false #false #false #false #false #false #false #false #false #false + #false #false #false #false #false #false #false #false #false #false + #false #false #false #false #false #false #false #false #false #false + #false #false #false #false #false #false #false #false #false #false + #false #false #false #false #false #false #false #false #false #false + #false #false #false #false #false #false #false #false #false #false + #false #false #false #false #false #false #false #false #false #false + #false #false #false #false #false #false #false #false #false #false + #false #false #false #false #false #false #false #false #false #false + #false #false #false #false #false #false #false #false #false #false + #false #false #false #false #false #false #false #false #false #false + #false #false #false #false #false #false #false #false #false #false + #false #false #false #false #false #false #false #false #false #false + #false #false #false #false #false #false #false #false #false #false + #false #false #false #false #false #false #false #false #false #false + #false #false #false #false #false #false #false #false #false #false + #false #false #false #false #false #false #false #false #false #false]) + + rfc8259-example1: NondeterministicTest( + #hex{} +{ + "Image": { + "Width": 800, + "Height": 600, + "Title": "View from 15th Floor", + "Thumbnail": { + "Url": "http://www.example.com/image/481989943", + "Height": 125, + "Width": 100 + }, + "Animated" : false, + "IDs": [116, 943, 234, 38793] + } +}) + + rfc8259-example2: NondeterministicTest( + #hex{} +[ + { + "precision": "zip", + "Latitude": 37.7668, + "Longitude": -122.3959, + "Address": "", + "City": "SAN FRANCISCO", + "State": "CA", + "Zip": "94107", + "Country": "US" + }, + { + "precision": "zip", + "Latitude": 37.371991, + "Longitude": -122.026020, + "Address": "", + "City": "SUNNYVALE", + "State": "CA", + "Zip": "94085", + "Country": "US" + } +]) + +}