further renames

main
Matthew Butterick 6 years ago
parent 2406027da7
commit e456116dee

@ -88,7 +88,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
(define size (send @type x:size #f parent))
(* size count)]))))
(define (+xarray [type-arg #f] [len-arg #f] [length-type-arg 'count]
(define (x:array [type-arg #f] [len-arg #f] [length-type-arg 'count]
#:type [type-kwarg #f]
#:length [len-kwarg #f]
#:count-bytes [count-bytes? #f]
@ -102,7 +102,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
(module+ test
(require rackunit "generic.rkt")
(check-equal? (decode (+xarray uint16be 3) #"ABCDEF") '(16706 17220 17734))
(check-equal? (encode (+xarray uint16be 3) '(16706 17220 17734) #f) #"ABCDEF")
(check-equal? (size (+xarray uint16be) '(1 2 3)) 6)
(check-equal? (size (+xarray doublebe) '(1 2 3 4 5)) 40))
(check-equal? (decode (x:array uint16be 3) #"ABCDEF") '(16706 17220 17734))
(check-equal? (encode (x:array uint16be 3) '(16706 17220 17734) #f) #"ABCDEF")
(check-equal? (size (x:array uint16be) '(1 2 3)) 6)
(check-equal? (size (x:array doublebe) '(1 2 3 4 5)) 40))

@ -31,7 +31,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Bitfield.coffee
(define/augment (x:size [val #f] [parent #f])
(send @type x:size))))
(define (+xbitfield [type-arg #f] [flag-arg #f]
(define (x:bitfield [type-arg #f] [flag-arg #f]
#:type [type-kwarg #f]
#:flags [flag-kwarg #f]
#:pre-encode [pre-proc #f]
@ -42,7 +42,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Bitfield.coffee
(module+ test
(require rackunit "number.rkt" "generic.rkt")
(define bfer (+xbitfield uint16be '(bold italic underline #f shadow condensed extended)))
(define bfer (x:bitfield uint16be '(bold italic underline #f shadow condensed extended)))
(define bf (decode bfer #"\0\25"))
(check-equal? (length (dict-keys bf)) 6) ; omits #f flag
(check-true (dict-ref bf 'bold))

@ -32,7 +32,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Buffer.coffee
(bytes-length val)
(resolve-length @len val #:parent parent)))))
(define (+xbuffer [len-arg #f]
(define (x:buffer [len-arg #f]
#:length [len-kwarg #f]
#:pre-encode [pre-proc #f]
#:post-decode [post-proc #f])

@ -30,7 +30,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Enum.coffee
(define/augment (x:size [val #f] [parent #f])
(send @type x:size val parent))))
(define (+xenum [type-arg #f] [values-arg #f]
(define (x:enum [type-arg #f] [values-arg #f]
#:type [type-kwarg #f]
#:values [values-kwarg #f]
#:pre-encode [pre-proc #f]

@ -38,7 +38,7 @@ https://github.com/mbutterick/restructure/blob/master/src/LazyArray.coffee
(define/override (x:size [val #f] [parent #f])
(super x:size (if (stream? val) (stream->list val) val) parent))))
(define (+xlazy-array [type-arg #f] [len-arg #f]
(define (x:lazy-array [type-arg #f] [len-arg #f]
#:type [type-kwarg #f]
#:length [len-kwarg #f]
#:pre-encode [pre-proc #f]
@ -53,13 +53,13 @@ https://github.com/mbutterick/restructure/blob/master/src/LazyArray.coffee
(require rackunit "number.rkt" "generic.rkt")
(define bstr #"ABCD1234")
(define ds (open-input-bytes bstr))
(define la (+xlazy-array uint8 4))
(define la (x:lazy-array uint8 4))
(define ila (decode la ds))
(check-equal? (pos ds) 4)
(check-equal? (stream-ref ila 1) 66)
(check-equal? (stream-ref ila 3) 68)
(check-equal? (pos ds) 4)
(check-equal? (stream->list ila) '(65 66 67 68))
(define la2 (+xlazy-array int16be (λ (t) 4)))
(define la2 (x:lazy-array int16be (λ (t) 4)))
(check-equal? (encode la2 '(1 2 3 4) #f) #"\0\1\0\2\0\3\0\4")
(check-equal? (stream->list (decode la2 (open-input-bytes #"\0\1\0\2\0\3\0\4"))) '(1 2 3 4)))

@ -70,41 +70,41 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee
([i (in-range @size)])
(values (cons (bitwise-and val #xff) bs) (arithmetic-shift val -8))))))
(define (+xint [size 2]
(define (x:int [size 2]
#:signed [signed #true]
#:endian [endian system-endian]
#:pre-encode [pre-proc #f]
#:post-decode [post-proc #f])
(new (generate-subclass x:int% pre-proc post-proc) [size size] [signed signed] [endian endian]))
(define int8 (+xint 1))
(define int16 (+xint 2))
(define int24 (+xint 3))
(define int32 (+xint 4))
(define uint8 (+xint 1 #:signed #f))
(define uint16 (+xint 2 #:signed #f))
(define uint24 (+xint 3 #:signed #f))
(define uint32 (+xint 4 #:signed #f))
(define int8be (+xint 1 #:endian 'be))
(define int16be (+xint 2 #:endian 'be))
(define int24be (+xint 3 #:endian 'be))
(define int32be (+xint 4 #:endian 'be))
(define uint8be (+xint 1 #:signed #f #:endian 'be))
(define uint16be (+xint 2 #:signed #f #:endian 'be))
(define uint24be (+xint 3 #:signed #f #:endian 'be))
(define uint32be (+xint 4 #:signed #f #:endian 'be))
(define int8le (+xint 1 #:endian 'le))
(define int16le (+xint 2 #:endian 'le))
(define int24le (+xint 3 #:endian 'le))
(define int32le (+xint 4 #:endian 'le))
(define uint8le (+xint 1 #:signed #f #:endian 'le))
(define uint16le (+xint 2 #:signed #f #:endian 'le))
(define uint24le (+xint 3 #:signed #f #:endian 'le))
(define uint32le (+xint 4 #:signed #f #:endian 'le))
(define int8 (x:int 1))
(define int16 (x:int 2))
(define int24 (x:int 3))
(define int32 (x:int 4))
(define uint8 (x:int 1 #:signed #f))
(define uint16 (x:int 2 #:signed #f))
(define uint24 (x:int 3 #:signed #f))
(define uint32 (x:int 4 #:signed #f))
(define int8be (x:int 1 #:endian 'be))
(define int16be (x:int 2 #:endian 'be))
(define int24be (x:int 3 #:endian 'be))
(define int32be (x:int 4 #:endian 'be))
(define uint8be (x:int 1 #:signed #f #:endian 'be))
(define uint16be (x:int 2 #:signed #f #:endian 'be))
(define uint24be (x:int 3 #:signed #f #:endian 'be))
(define uint32be (x:int 4 #:signed #f #:endian 'be))
(define int8le (x:int 1 #:endian 'le))
(define int16le (x:int 2 #:endian 'le))
(define int24le (x:int 3 #:endian 'le))
(define int32le (x:int 4 #:endian 'le))
(define uint8le (x:int 1 #:signed #f #:endian 'le))
(define uint16le (x:int 2 #:signed #f #:endian 'le))
(define uint24le (x:int 3 #:signed #f #:endian 'le))
(define uint32le (x:int 4 #:signed #f #:endian 'le))
(module+ test
(require rackunit "generic.rkt")
(check-exn exn:fail:contract? (λ () (+xint 'not-a-valid-type)))
(check-exn exn:fail:contract? (λ () (x:int 'not-a-valid-type)))
(check-exn exn:fail:contract? (λ () (encode uint8 256 #f)))
(check-not-exn (λ () (encode uint8 255 #f)))
(check-exn exn:fail:contract? (λ () (encode int8 256 #f)))
@ -115,7 +115,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee
(check-exn exn:fail:contract? (λ () (encode uint16 (add1 #xffff) #f)))
(check-not-exn (λ () (encode uint16 #xffff #f)))
(let ([i (+xint 2 #:signed #f #:endian 'le)]
(let ([i (x:int 2 #:signed #f #:endian 'le)]
[ip (open-input-bytes (bytes 1 2 3 4))]
[op (open-output-bytes)])
(check-equal? (decode i ip) 513) ;; 1000 0000 0100 0000
@ -125,7 +125,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee
(encode i 1027 op)
(check-equal? (get-output-bytes op) (bytes 1 2 3 4)))
(let ([i (+xint 2 #:signed #f #:endian 'be)]
(let ([i (x:int 2 #:signed #f #:endian 'be)]
[ip (open-input-bytes (bytes 1 2 3 4))]
[op (open-output-bytes)])
(check-equal? (decode i ip) 258) ;; 0100 0000 1000 0000
@ -135,10 +135,10 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee
(encode i 772 op)
(check-equal? (get-output-bytes op) (bytes 1 2 3 4)))
(check-equal? (size (+xint 1)) 1)
(check-equal? (size (+xint)) 2)
(check-equal? (size (+xint 4)) 4)
(check-equal? (size (+xint 8)) 8)
(check-equal? (size (x:int 1)) 1)
(check-equal? (size (x:int)) 2)
(check-equal? (size (x:int 4)) 4)
(check-equal? (size (x:int 8)) 8)
(check-equal? (decode int8 (bytes 127)) 127)
(check-equal? (decode int8 (bytes 255)) -1)
@ -156,18 +156,18 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee
(define/augment (x:encode val . _)
(real->floating-point-bytes val @size (eq? @endian 'be)))))
(define (+xfloat [size 4] #:endian [endian system-endian]
(define (x:float [size 4] #:endian [endian system-endian]
#:pre-encode [pre-proc #f]
#:post-decode [post-proc #f])
(new (generate-subclass x:float% pre-proc post-proc) [size size] [endian endian]))
(define float (+xfloat 4))
(define floatbe (+xfloat 4 #:endian 'be))
(define floatle (+xfloat 4 #:endian 'le))
(define float (x:float 4))
(define floatbe (x:float 4 #:endian 'be))
(define floatle (x:float 4 #:endian 'le))
(define double (+xfloat 8))
(define doublebe (+xfloat 8 #:endian 'be))
(define doublele (+xfloat 8 #:endian 'le))
(define double (x:float 8))
(define doublebe (x:float 8 #:endian 'be))
(define doublele (x:float 8 #:endian 'le))
(define x:fixed%
(class x:int%
@ -184,7 +184,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee
(define/override (pre-encode val)
(exact-if-possible (floor (* val fixed-shift))))))
(define (+xfixed [size 2]
(define (x:fixed [size 2]
#:signed [signed #true]
#:endian [endian system-endian]
#:fracbits [fracbits (/ (* size 8) 2)]
@ -192,12 +192,12 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee
#:post-decode [post-proc #f])
(new (generate-subclass x:fixed% pre-proc post-proc) [size size] [signed signed] [endian endian] [fracbits fracbits]))
(define fixed16 (+xfixed 2))
(define fixed16be (+xfixed 2 #:endian 'be))
(define fixed16le (+xfixed 2 #:endian 'le))
(define fixed32 (+xfixed 4))
(define fixed32be (+xfixed 4 #:endian 'be))
(define fixed32le (+xfixed 4 #:endian 'le))
(define fixed16 (x:fixed 2))
(define fixed16be (x:fixed 2 #:endian 'be))
(define fixed16le (x:fixed 2 #:endian 'le))
(define fixed32 (x:fixed 4))
(define fixed32be (x:fixed 4 #:endian 'be))
(define fixed32le (x:fixed 4 #:endian 'le))
(module+ test
(define bs (encode fixed16be 123.45 #f))

@ -32,7 +32,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Optional.coffee
(define no-val (gensym))
(define (+xoptional [type-arg #f] [cond-arg no-val]
(define (x:optional [type-arg #f] [cond-arg no-val]
#:type [type-kwarg #f]
#:condition [cond-kwarg no-val]
#:pre-encode [pre-proc #f]

@ -90,7 +90,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee
(+ (dict-ref new-parent 'pointerSize) (send type x:size val new-parent)))))
(send @offset-type x:size))))
(define (+xpointer [offset-arg #f] [type-arg #f]
(define (x:pointer [offset-arg #f] [type-arg #f]
#:offset-type [offset-kwarg #f]
#:type [type-kwarg #f]
#:relative-to [pointer-relative-to 'local]
@ -115,7 +115,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee
(define x:void-pointer% (class x:enobase%
(super-new)
(init-field type value)))
(define (+xvoid-pointer . args) (apply make-object x:void-pointer% args))
(define (x:void-pointer . args) (apply make-object x:void-pointer% args))
(define (xvoid-pointer? x) (is-a? x x:void-pointer%))
(define (xvoid-pointer-type x) (get-field type x))
(define (xvoid-pointer-value x) (get-field value x))

@ -25,7 +25,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Reserved.coffee
(define/augment (x:size [val #f] [parent #f])
(* (send @type x:size) (resolve-length @count #f #:parent parent)))))
(define (+xreserved [type-arg #f] [count-arg #f]
(define (x:reserved [type-arg #f] [count-arg #f]
#:type [type-kwarg #f]
#:count [count-kwarg #f]
#:pre-encode [pre-proc #f]

@ -80,7 +80,7 @@ https://github.com/mbutterick/restructure/blob/master/src/String.coffee
[else (resolve-length @len #f #:parent parent)]))))
(define supported-encodings '(ascii utf8))
(define (+xstring [len-arg #f] [enc-arg #f]
(define (x:string [len-arg #f] [enc-arg #f]
#:length [len-kwarg #f]
#:encoding [enc-kwarg #f]
#:pre-encode [pre-proc #f]
@ -101,7 +101,7 @@ https://github.com/mbutterick/restructure/blob/master/src/String.coffee
(define/override (post-decode val) (string->symbol val))))
(define (+xsymbol [len-arg #f] [enc-arg #f]
(define (x:symbol [len-arg #f] [enc-arg #f]
#:length [len-kwarg #f]
#:encoding [enc-kwarg #f]
#:pre-encode [pre-proc #f]
@ -112,14 +112,14 @@ https://github.com/mbutterick/restructure/blob/master/src/String.coffee
(module+ test
(require rackunit "generic.rkt")
(define S-fixed (+xstring 4 'utf8))
(define S-fixed (x:string 4 'utf8))
(check-equal? (encode S-fixed "Mike" #f) #"Mike")
(check-exn exn:fail? (λ () (encode S-fixed "Mikes" #f))) ; too long for fixed string
(define S (+xstring uint8 'utf8))
(define S (x:string uint8 'utf8))
(check-equal? (decode S #"\2BCDEF") "BC")
(check-equal? (encode S "Mike" #f) #"\4Mike")
(check-equal? (size (+xstring) "foobar") 7) ; null terminated when no len
(check-equal? (decode (+xsymbol 4) #"Mike") 'Mike)
(check-equal? (encode (+xsymbol 4) 'Mike #f) #"Mike")
(check-equal? (encode (+xsymbol 4) "Mike" #f) #"Mike")
(check-exn exn:fail:contract? (λ () (encode (+xsymbol 4) 42 #f))))
(check-equal? (size (x:string) "foobar") 7) ; null terminated when no len
(check-equal? (decode (x:symbol 4) #"Mike") 'Mike)
(check-equal? (encode (x:symbol 4) 'Mike #f) #"Mike")
(check-equal? (encode (x:symbol 4) "Mike" #f) #"Mike")
(check-exn exn:fail:contract? (λ () (encode (x:symbol 4) 42 #f))))

@ -95,7 +95,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
(define (xstruct? x) (is-a? x x:struct%))
(define (+xstruct #:pre-encode [pre-proc #f]
(define (x:struct #:pre-encode [pre-proc #f]
#:post-decode [post-proc #f] . dicts)
(define args (flatten dicts))
(unless (even? (length args))
@ -109,7 +109,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
(module+ test
(require rackunit "number.rkt" "generic.rkt")
(define (random-pick xs) (list-ref xs (random (length xs))))
(check-exn exn:fail:contract? (λ () (+xstruct 42)))
(check-exn exn:fail:contract? (λ () (x:struct 42)))
(for ([i (in-range 20)])
;; make random structs and make sure we can round trip
(define field-types
@ -118,7 +118,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
(define size-num-types
(for/sum ([num-type (in-list field-types)])
(size num-type)))
(define xs (+xstruct (for/list ([num-type (in-list field-types)])
(define xs (x:struct (for/list ([num-type (in-list field-types)])
(cons (gensym) num-type))))
(define bs (apply bytes (for/list ([i (in-range size-num-types)])
(random 256))))

@ -15,92 +15,92 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee
(test-case
"array: decode fixed length"
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(check-equal? (decode (+xarray #:type uint8 #:length 4)) '(1 2 3 4))))
(check-equal? (decode (x:array #:type uint8 #:length 4)) '(1 2 3 4))))
(test-case
"array: decode with post-decode"
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(define xa (+xarray #:type uint8 #:length 4 #:post-decode (λ (val) (map (λ (x) (* 2 x)) val))))
(define xa (x:array #:type uint8 #:length 4 #:post-decode (λ (val) (map (λ (x) (* 2 x)) val))))
(check-equal? (decode xa) '(2 4 6 8))))
(test-case
"array: decode fixed number of bytes"
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(check-equal? (decode (+xarray #:type uint16be #:length 4 #:count-bytes #t)) '(258 772))))
(check-equal? (decode (x:array #:type uint16be #:length 4 #:count-bytes #t)) '(258 772))))
(test-case
"array: decode length from parent key"
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(check-equal? (decode (+xarray #:type uint8 #:length 'len) (current-input-port) #:parent (mhash 'len 4)) '(1 2 3 4))))
(check-equal? (decode (x:array #:type uint8 #:length 'len) (current-input-port) #:parent (mhash 'len 4)) '(1 2 3 4))))
(test-case
"array: decode byte count from parent key"
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(check-equal? (decode (+xarray #:type uint16be #:length 'len #:count-bytes #t) (current-input-port) #:parent (mhash 'len 4)) '(258 772))))
(check-equal? (decode (x:array #:type uint16be #:length 'len #:count-bytes #t) (current-input-port) #:parent (mhash 'len 4)) '(258 772))))
(test-case
"array: decode length as number before array"
(parameterize ([current-input-port (open-input-bytes (bytes 4 1 2 3 4 5))])
(check-equal? (decode (+xarray #:type uint8 #:length uint8)) '(1 2 3 4))))
(check-equal? (decode (x:array #:type uint8 #:length uint8)) '(1 2 3 4))))
(test-case
"array: decode byte count as number before array"
(parameterize ([current-input-port (open-input-bytes (bytes 4 1 2 3 4 5))])
(check-equal? (decode (+xarray #:type uint16be #:length uint8 #:count-bytes #t)) '(258 772))))
(check-equal? (decode (x:array #:type uint16be #:length uint8 #:count-bytes #t)) '(258 772))))
(test-case
"array: decode length from function"
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(check-equal? (decode (+xarray #:type uint8 #:length (λ _ 4))) '(1 2 3 4))))
(check-equal? (decode (x:array #:type uint8 #:length (λ _ 4))) '(1 2 3 4))))
(test-case
"array: decode byte count from function"
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(check-equal? (decode (+xarray #:type uint16be #:length (λ _ 4) #:count-bytes #t)) '(258 772))))
(check-equal? (decode (x:array #:type uint16be #:length (λ _ 4) #:count-bytes #t)) '(258 772))))
(test-case
"array: decode to the end of parent if no length given"
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(check-equal? (decode (+xarray #:type uint8) (current-input-port) #:parent (mhash '_length 4 '_startOffset 0)) '(1 2 3 4))))
(check-equal? (decode (x:array #:type uint8) (current-input-port) #:parent (mhash '_length 4 '_startOffset 0)) '(1 2 3 4))))
(test-case
"array: decode to the end of the stream if parent exists, but its length is 0"
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(check-equal? (decode (+xarray #:type uint8) (current-input-port) #:parent (mhash '_length 0 '_startOffset 0)) '(1 2 3 4 5))))
(check-equal? (decode (x:array #:type uint8) (current-input-port) #:parent (mhash '_length 0 '_startOffset 0)) '(1 2 3 4 5))))
(test-case
"array: decode to the end of the stream if no parent and length is given"
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4))])
(check-equal? (decode (+xarray #:type uint8)) '(1 2 3 4 ))))
(check-equal? (decode (x:array #:type uint8)) '(1 2 3 4 ))))
(test-case
"array: use array length"
(check-equal? (size (+xarray #:type uint8 #:length 10) '(1 2 3 4)) 4))
(check-equal? (size (x:array #:type uint8 #:length 10) '(1 2 3 4)) 4))
(test-case
"array: add size of length field before string"
(check-equal? (size (+xarray #:type uint8 #:length uint8) '(1 2 3 4)) 5))
(check-equal? (size (x:array #:type uint8 #:length uint8) '(1 2 3 4)) 5))
(test-case
"array: use defined length if no value given"
(check-equal? (size (+xarray #:type uint8 #:length 10)) 10))
(check-equal? (size (x:array #:type uint8 #:length 10)) 10))
(test-case
"array: encode using array length"
(check-equal? (encode (+xarray #:type uint8 #:length 10) '(1 2 3 4) #f) (bytes 1 2 3 4)))
(check-equal? (encode (x:array #:type uint8 #:length 10) '(1 2 3 4) #f) (bytes 1 2 3 4)))
(test-case
"array: encode with pre-encode"
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(define xa (+xarray #:type uint8 #:length 4 #:pre-encode (λ (val) (map (λ (x) (* 2 x)) val))))
(define xa (x:array #:type uint8 #:length 4 #:pre-encode (λ (val) (map (λ (x) (* 2 x)) val))))
(check-equal? (encode xa '(1 2 3 4) #f) (bytes 2 4 6 8))))
(test-case
"array: encode length as number before array"
(check-equal? (encode (+xarray #:type uint8 #:length uint8) '(1 2 3 4) #f) (bytes 4 1 2 3 4)))
(check-equal? (encode (x:array #:type uint8 #:length uint8) '(1 2 3 4) #f) (bytes 4 1 2 3 4)))
(test-case
"array: add pointers after array if length is encoded at start"
(check-equal? (encode (+xarray #:type (+xpointer #:offset-type uint8
(check-equal? (encode (x:array #:type (x:pointer #:offset-type uint8
#:type uint8)
#:length uint8) '(1 2 3 4) #f) (bytes 4 5 6 7 8 1 2 3 4)))

@ -13,7 +13,7 @@ approximates
https://github.com/mbutterick/restructure/blob/master/test/Bitfield.coffee
|#
(define bitfield (+xbitfield uint8 '(Jack Kack Lack Mack Nack Oack Pack Quack)))
(define bitfield (x:bitfield uint8 '(Jack Kack Lack Mack Nack Oack Pack Quack)))
(match-define (list JACK KACK LACK MACK NACK OACK PACK QUACK)
(map (λ (x) (arithmetic-shift 1 x)) (range 8)))
@ -36,7 +36,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Bitfield.coffee
(test-case
"bitfield: should decode with post-decode"
(parameterize ([current-input-port (open-input-bytes (bytes (bitwise-ior JACK MACK PACK NACK QUACK)))])
(define bitfield (+xbitfield uint8 '(Jack Kack Lack Mack Nack Oack Pack Quack) #:post-decode (λ (fh) (hash-set! fh 'foo 42) fh)))
(define bitfield (x:bitfield uint8 '(Jack Kack Lack Mack Nack Oack Pack Quack) #:post-decode (λ (fh) (hash-set! fh 'foo 42) fh)))
(check-equal? (decode bitfield) (mhasheq 'Quack #t
'Nack #t
'Lack #f
@ -61,7 +61,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Bitfield.coffee
(test-case
"bitfield: should encode with pre-encode"
(define bitfield (+xbitfield uint8 '(Jack Kack Lack Mack Nack Oack Pack Quack)
(define bitfield (x:bitfield uint8 '(Jack Kack Lack Mack Nack Oack Pack Quack)
#:pre-encode (λ (fh)
(hash-set! fh 'Jack #f)
(hash-set! fh 'Mack #f)

@ -13,39 +13,39 @@ https://github.com/mbutterick/restructure/blob/master/test/Buffer.coffee
(test-case
"buffer: should decode"
(parameterize ([current-input-port (open-input-bytes (bytes #xab #xff #x1f #xb6))])
(define buf (+xbuffer #:length 2))
(define buf (x:buffer #:length 2))
(check-equal? (decode buf) (bytes #xab #xff))
(check-equal? (decode buf) (bytes #x1f #xb6))))
(test-case
"buffer: should error on invalid length"
(check-exn exn:fail:contract? (λ () (+xbuffer #:length #true))))
(check-exn exn:fail:contract? (λ () (x:buffer #:length #true))))
(test-case
"buffer: should decode with post-decode"
(parameterize ([current-input-port (open-input-bytes (bytes #xab #xff #x1f #xb6))])
(define buf (+xbuffer #:length 2 #:post-decode (λ (val) (bytes 1 2))))
(define buf (x:buffer #:length 2 #:post-decode (λ (val) (bytes 1 2))))
(check-equal? (decode buf) (bytes 1 2))
(check-equal? (decode buf) (bytes 1 2))))
(test-case
"buffer: should decode with parent key length"
(parameterize ([current-input-port (open-input-bytes (bytes #xab #xff #x1f #xb6))])
(define buf (+xbuffer #:length 'len))
(define buf (x:buffer #:length 'len))
(check-equal? (decode buf #:parent (hash 'len 3)) (bytes #xab #xff #x1f))
(check-equal? (decode buf #:parent (hash 'len 1)) (bytes #xb6))))
(test-case
"buffer: hould return size"
(check-equal? (size (+xbuffer #:length 2) (bytes #xab #xff)) 2))
(check-equal? (size (x:buffer #:length 2) (bytes #xab #xff)) 2))
(test-case
"buffer: hould use defined length if no value given"
(check-equal? (size (+xbuffer #:length 10)) 10))
(check-equal? (size (x:buffer #:length 10)) 10))
(test-case
"buffer: should encode"
(let ([buf (+xbuffer 2)])
(let ([buf (x:buffer 2)])
(check-equal? (bytes-append
(encode buf (bytes #xab #xff) #f)
(encode buf (bytes #x1f #xb6) #f)) (bytes #xab #xff #x1f #xb6))))
@ -53,11 +53,11 @@ https://github.com/mbutterick/restructure/blob/master/test/Buffer.coffee
(test-case
"buffer: should encode with pre-encode"
(let ()
(define buf (+xbuffer 2 #:pre-encode (λ (val) (bytes 1 2))))
(define buf (x:buffer 2 #:pre-encode (λ (val) (bytes 1 2))))
(check-equal? (bytes-append
(encode buf (bytes #xab #xff) #f)
(encode buf (bytes #x1f #xb6) #f)) (bytes 1 2 1 2))))
(test-case
"buffer: should encode length before buffer"
(check-equal? (encode (+xbuffer #:length uint8) (bytes #xab #xff) #f) (bytes 2 #xab #xff)))
(check-equal? (encode (x:buffer #:length uint8) (bytes #xab #xff) #f) (bytes 2 #xab #xff)))

@ -10,16 +10,16 @@ approximates
https://github.com/mbutterick/restructure/blob/master/test/Enum.coffee
|#
(define e (+xenum #:type uint8
(define e (x:enum #:type uint8
#:values '("foo" "bar" "baz")))
(test-case
"enum: should error with invalid type"
(check-exn exn:fail:contract? (λ () (+xenum 42))))
(check-exn exn:fail:contract? (λ () (x:enum 42))))
(test-case
"enum: should error with invalid values"
(check-exn exn:fail:contract? (λ () (+xenum #:values 42))))
(check-exn exn:fail:contract? (λ () (x:enum #:values 42))))
(test-case
"enum: should have the right size"
@ -35,7 +35,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Enum.coffee
(test-case
"enum: decode should decode with post-decode"
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 0))])
(define e2 (+xenum #:type uint8
(define e2 (x:enum #:type uint8
#:values '("foo" "bar" "baz")
#:post-decode (λ (val) "foobar")))
(check-equal? (decode e2) "foobar")
@ -53,7 +53,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Enum.coffee
(test-case
"enum: encode should encode with pre-encode"
(parameterize ([current-output-port (open-output-bytes)])
(define e2 (+xenum #:type uint8
(define e2 (x:enum #:type uint8
#:values '("foo" "bar" "baz")
#:pre-encode (λ (val) "foo")))
(encode e2 "bar")

@ -16,7 +16,7 @@ https://github.com/mbutterick/restructure/blob/master/test/LazyArray.coffee
(test-case
"lazy-array: decode should decode items lazily"
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(define xla (+xlazy-array uint8 4))
(define xla (x:lazy-array uint8 4))
(define arr (decode xla))
(check-equal? (stream-length arr) 4)
(check-equal? (pos (current-input-port)) 4)
@ -28,7 +28,7 @@ https://github.com/mbutterick/restructure/blob/master/test/LazyArray.coffee
(test-case
"lazy-array: decode should decode items lazily with post-decode"
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(define xla (+xlazy-array uint8 4 #:post-decode (λ (str) (stream-map (λ (i) (* 2 i)) str))))
(define xla (x:lazy-array uint8 4 #:post-decode (λ (str) (stream-map (λ (i) (* 2 i)) str))))
(define arr (decode xla))
(check-false (xarray? arr))
(check-equal? (stream-length arr) 4)
@ -41,34 +41,34 @@ https://github.com/mbutterick/restructure/blob/master/test/LazyArray.coffee
(test-case
"lazy-array: should be able to convert to an array"
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(define xla (+xlazy-array uint8 4))
(define xla (x:lazy-array uint8 4))
(define arr (decode xla))
(check-equal? (stream->list arr) '(1 2 3 4))))
(test-case
"lazy-array: decode should decode length as number before array"
(parameterize ([current-input-port (open-input-bytes (bytes 4 1 2 3 4 5))])
(define xla (+xlazy-array uint8 uint8))
(define xla (x:lazy-array uint8 uint8))
(define arr (decode xla))
(check-equal? (stream->list arr) '(1 2 3 4))))
(test-case
"lazy-array: size should work with xlazy-arrays"
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(define xla (+xlazy-array uint8 4))
(define xla (x:lazy-array uint8 4))
(define arr (decode xla))
(check-equal? (size xla arr) 4)))
(test-case
"lazy-array: encode should work with xlazy-arrays"
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(define xla (+xlazy-array uint8 4))
(define xla (x:lazy-array uint8 4))
(define arr (decode xla))
(check-equal? (encode xla arr #f) (bytes 1 2 3 4))))
(test-case
"lazy-array: encode should work with xlazy-arrays with pre-encode"
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(define xla (+xlazy-array uint8 4 #:pre-encode (λ (str) (stream-map (λ (val) (* 2 val)) str))))
(define xla (x:lazy-array uint8 4 #:pre-encode (λ (str) (stream-map (λ (val) (* 2 val)) str))))
(define arr (decode xla))
(check-equal? (encode xla arr #f) (bytes 2 4 6 8))))

@ -22,7 +22,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Number.coffee
(test-case
"number: uint8: decode with post-decode, size, encode with pre-encode"
(define myuint8 (+xint 1 #:signed #f
(define myuint8 (x:int 1 #:signed #f
#:post-decode (λ (val) #xdeadbeef)
#:pre-encode (λ (val) #xcc)))
(parameterize ([current-input-port (open-input-bytes (bytes #xab #xff))])

@ -14,103 +14,103 @@ https://github.com/mbutterick/restructure/blob/master/test/Optional.coffee
(test-case
"optional: decode should not decode when condition is falsy"
(parameterize ([current-input-port (open-input-bytes (bytes 0))])
(define optional (+xoptional #:type uint8 #:condition #f))
(define optional (x:optional #:type uint8 #:condition #f))
(check-equal? (decode optional) (void))
(check-equal? (pos (current-input-port)) 0)))
(test-case
"optional: decode with post-decode"
(parameterize ([current-input-port (open-input-bytes (bytes 0))])
(define optional (+xoptional #:type uint8 #:condition #f #:post-decode (λ (val) 42)))
(define optional (x:optional #:type uint8 #:condition #f #:post-decode (λ (val) 42)))
(check-equal? (decode optional) 42)
(check-equal? (pos (current-input-port)) 0)))
(test-case
"optional: decode should not decode when condition is a function and falsy"
(parameterize ([current-input-port (open-input-bytes (bytes 0))])
(define optional (+xoptional #:type uint8 #:condition (λ _ #f)))
(define optional (x:optional #:type uint8 #:condition (λ _ #f)))
(check-equal? (decode optional) (void))
(check-equal? (pos (current-input-port)) 0)))
(test-case
"optional: decode should decode when condition is omitted"
(parameterize ([current-input-port (open-input-bytes (bytes 0))])
(define optional (+xoptional #:type uint8))
(define optional (x:optional #:type uint8))
(check-not-equal? (decode optional) (void))
(check-equal? (pos (current-input-port)) 1)))
(test-case
"optional: decode should decode when condition is truthy"
(parameterize ([current-input-port (open-input-bytes (bytes 0))])
(define optional (+xoptional #:type uint8 #:condition #t))
(define optional (x:optional #:type uint8 #:condition #t))
(check-not-equal? (decode optional) (void))
(check-equal? (pos (current-input-port)) 1)))
(test-case
"optional: decode should decode when condition is a function and truthy"
(parameterize ([current-input-port (open-input-bytes (bytes 0))])
(define optional (+xoptional #:type uint8 #:condition (λ _ #t)))
(define optional (x:optional #:type uint8 #:condition (λ _ #t)))
(check-not-equal? (decode optional) (void))
(check-equal? (pos (current-input-port)) 1)))
(test-case
"optional: size"
(check-equal? (size (+xoptional #:type uint8 #:condition #f)) 0))
(check-equal? (size (x:optional #:type uint8 #:condition #f)) 0))
(test-case
"optional: size should return 0 when condition is a function and falsy"
(check-equal? (size (+xoptional #:type uint8 #:condition (λ _ #f))) 0))
(check-equal? (size (x:optional #:type uint8 #:condition (λ _ #f))) 0))
(test-case
"optional: size should return given type size when condition is omitted"
(check-equal? (size (+xoptional #:type uint8)) 1))
(check-equal? (size (x:optional #:type uint8)) 1))
(test-case
"optional: size should return given type size when condition is truthy"
(check-equal? (size (+xoptional #:type uint8 #:condition #t)) 1))
(check-equal? (size (x:optional #:type uint8 #:condition #t)) 1))
(test-case
"optional: size should return given type size when condition is a function and truthy"
(check-equal? (size (+xoptional #:type uint8 #:condition (λ _ #t))) 1))
(check-equal? (size (x:optional #:type uint8 #:condition (λ _ #t))) 1))
(test-case
"optional: encode should not encode when condition is falsy"
(parameterize ([current-output-port (open-output-bytes)])
(define optional (+xoptional #:type uint8 #:condition #f))
(define optional (x:optional #:type uint8 #:condition #f))
(encode optional 128)
(check-equal? (get-output-bytes (current-output-port)) (bytes))))
(test-case
"optional: encode with pre-encode"
(parameterize ([current-output-port (open-output-bytes)])
(define optional (+xoptional #:type uint8 #:pre-encode (λ (val) 42)))
(define optional (x:optional #:type uint8 #:pre-encode (λ (val) 42)))
(encode optional 128)
(check-equal? (get-output-bytes (current-output-port)) (bytes 42))))
(test-case
"optional: encode should not encode when condition is a function and falsy"
(parameterize ([current-output-port (open-output-bytes)])
(define optional (+xoptional #:type uint8 #:condition (λ _ #f)))
(define optional (x:optional #:type uint8 #:condition (λ _ #f)))
(encode optional 128)
(check-equal? (get-output-bytes (current-output-port)) (bytes))))
(test-case
"optional: encode should encode when condition is omitted"
(parameterize ([current-output-port (open-output-bytes)])
(define optional (+xoptional #:type uint8))
(define optional (x:optional #:type uint8))
(encode optional 128)
(check-equal? (get-output-bytes (current-output-port)) (bytes 128))))
(test-case
"optional: encode should encode when condition is truthy"
(parameterize ([current-output-port (open-output-bytes)])
(define optional (+xoptional #:type uint8 #:condition #t))
(define optional (x:optional #:type uint8 #:condition #t))
(encode optional 128)
(check-equal? (get-output-bytes (current-output-port)) (bytes 128))))
(test-case
"optional: encode should encode when condition is a function and truthy"
(parameterize ([current-output-port (open-output-bytes)])
(define optional (+xoptional #:type uint8 #:condition (λ _ #t)))
(define optional (x:optional #:type uint8 #:condition (λ _ #t)))
(encode optional 128)
(check-equal? (get-output-bytes (current-output-port)) (bytes 128))))

@ -18,81 +18,81 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee
(test-case
"pointer: decode should handle null pointers"
(parameterize ([current-input-port (open-input-bytes (bytes 0))])
(check-false (decode (+xpointer) #:parent (mhash '_startOffset 50)))))
(check-false (decode (x:pointer) #:parent (mhash '_startOffset 50)))))
(test-case
"pointer: decode should use local offsets from start of parent by default"
(parameterize ([current-input-port (open-input-bytes (bytes 1 53))])
(check-equal? (decode (+xpointer) #:parent (mhash '_startOffset 0)) 53)))
(check-equal? (decode (x:pointer) #:parent (mhash '_startOffset 0)) 53)))
(test-case
"pointer: decode should support immediate offsets"
(parameterize ([current-input-port (open-input-bytes (bytes 1 53))])
(check-equal? (decode (+xpointer #:relative-to 'immediate)) 53)))
(check-equal? (decode (x:pointer #:relative-to 'immediate)) 53)))
(test-case
"pointer: decode should support offsets relative to the parent"
(parameterize ([current-input-port (open-input-bytes (bytes 0 0 1 53))])
(pos (current-input-port) 2)
(check-equal? (decode (+xpointer #:relative-to 'parent) #:parent (mhash 'parent (mhash '_startOffset 2))) 53)))
(check-equal? (decode (x:pointer #:relative-to 'parent) #:parent (mhash 'parent (mhash '_startOffset 2))) 53)))
(test-case
"pointer: decode should support global offsets"
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 4 0 0 0 53))])
(pos (current-input-port) 2)
(check-equal? (decode (+xpointer #:relative-to 'global) #:parent (mhash 'parent (mhash 'parent (mhash '_startOffset 2))))
(check-equal? (decode (x:pointer #:relative-to 'global) #:parent (mhash 'parent (mhash 'parent (mhash '_startOffset 2))))
53)))
(test-case
"pointer: decode should support returning pointer if there is no decode type"
(parameterize ([current-input-port (open-input-bytes (bytes 4))])
(check-equal? (decode (+xpointer uint8 'void) #:parent (mhash '_startOffset 0)) 4)))
(check-equal? (decode (x:pointer uint8 'void) #:parent (mhash '_startOffset 0)) 4)))
(test-case
"pointer: decode should support decoding pointers lazily"
(parameterize ([current-input-port (open-input-bytes (bytes 1 53))])
(define res (decode (+xstruct 'ptr (+xpointer #:lazy #t))))
(define res (decode (x:struct 'ptr (x:pointer #:lazy #t))))
(check-true (promise? (dict-ref res 'ptr)))
(check-equal? (force (dict-ref res 'ptr)) 53)))
(test-case
"pointer: size"
(let ([parent (mhash 'pointerSize 0)])
(check-equal? (size (+xpointer) 10 #:parent parent) 1)
(check-equal? (size (x:pointer) 10 #:parent parent) 1)
(check-equal? (dict-ref parent 'pointerSize) 1)))
(test-case
"pointer: size should add to immediate pointerSize"
(let ([parent (mhash 'pointerSize 0)])
(check-equal? (size (+xpointer #:relative-to 'immediate) 10 #:parent parent) 1)
(check-equal? (size (x:pointer #:relative-to 'immediate) 10 #:parent parent) 1)
(check-equal? (dict-ref parent 'pointerSize) 1)))
(test-case
"pointer: size should add to parent pointerSize"
(let ([parent (mhash 'parent (mhash 'pointerSize 0))])
(check-equal? (size (+xpointer #:relative-to 'parent) 10 #:parent parent) 1)
(check-equal? (size (x:pointer #:relative-to 'parent) 10 #:parent parent) 1)
(check-equal? (dict-ref* parent 'parent 'pointerSize) 1)))
(test-case
"pointer: size should add to global pointerSize"
(let ([parent (mhash 'parent (mhash 'parent (mhash 'parent (mhash 'pointerSize 0))))])
(check-equal? (size (+xpointer #:relative-to 'global) 10 #:parent parent) 1)
(check-equal? (size (x:pointer #:relative-to 'global) 10 #:parent parent) 1)
(check-equal? (dict-ref* parent 'parent 'parent 'parent 'pointerSize) 1)))
(test-case
"pointer: size should handle void pointers"
(let ([parent (mhash 'pointerSize 0)])
(check-equal? (size (+xpointer uint8 'void) (+xvoid-pointer uint8 50) #:parent parent) 1)
(check-equal? (size (x:pointer uint8 'void) (x:void-pointer uint8 50) #:parent parent) 1)
(check-equal? (dict-ref parent 'pointerSize) 1)))
(test-case
"pointer: size should throw if no type and not a void pointer"
(let ([parent (mhash 'pointerSize 0)])
(check-exn exn:fail:contract? (λ () (size (+xpointer uint8 'void) 30 #:parent parent)))))
(check-exn exn:fail:contract? (λ () (size (x:pointer uint8 'void) 30 #:parent parent)))))
(test-case
"pointer: size should return a fixed size without a value"
(check-equal? (size (+xpointer)) 1))
(check-equal? (size (x:pointer)) 1))
(test-case
"pointer: encode should handle null pointers"
@ -101,7 +101,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee
'startOffset 0
'pointerOffset 0
'pointers null))
(encode (+xpointer) #f #:parent parent)
(encode (x:pointer) #f #:parent parent)
(check-equal? (dict-ref parent 'pointerSize) 0)
(check-equal? (get-output-bytes (current-output-port)) (bytes 0))))
@ -112,7 +112,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee
'startOffset 0
'pointerOffset 1
'pointers null))
(encode (+xpointer) 10 #:parent parent)
(encode (x:pointer) 10 #:parent parent)
(check-equal? (dict-ref parent 'pointerOffset) 2)
(check-equal? (dict-ref parent 'pointers) (list (mhasheq 'type uint8
'val 10
@ -126,7 +126,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee
'startOffset 0
'pointerOffset 1
'pointers null))
(encode (+xpointer #:relative-to 'immediate) 10 #:parent parent)
(encode (x:pointer #:relative-to 'immediate) 10 #:parent parent)
(check-equal? (dict-ref parent 'pointerOffset) 2)
(check-equal? (dict-ref parent 'pointers) (list (mhasheq 'type uint8
'val 10
@ -140,7 +140,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee
'startOffset 3
'pointerOffset 5
'pointers null)))
(encode (+xpointer #:relative-to 'parent) 10 #:parent parent)
(encode (x:pointer #:relative-to 'parent) 10 #:parent parent)
(check-equal? (dict-ref* parent 'parent 'pointerOffset) 6)
(check-equal? (dict-ref* parent 'parent 'pointers) (list (mhasheq 'type uint8
'val 10
@ -156,7 +156,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee
'startOffset 3
'pointerOffset 5
'pointers null)))))
(encode (+xpointer #:relative-to 'global) 10 #:parent parent)
(encode (x:pointer #:relative-to 'global) 10 #:parent parent)
(check-equal? (dict-ref* parent 'parent 'parent 'parent 'pointerOffset) 6)
(check-equal? (dict-ref* parent 'parent 'parent 'parent 'pointers)
(list (mhasheq 'type uint8
@ -171,7 +171,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee
'startOffset 0
'pointerOffset 1
'pointers null))
(encode (+xpointer uint8 'void) (+xvoid-pointer uint8 55) #:parent parent)
(encode (x:pointer uint8 'void) (x:void-pointer uint8 55) #:parent parent)
(check-equal? (dict-ref parent 'pointerOffset) 2)
(check-equal? (dict-ref parent 'pointers) (list (mhasheq 'type uint8 'val 55 'parent parent)))
(check-equal? (get-output-bytes (current-output-port)) (bytes 1))))
@ -183,4 +183,4 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee
'startOffset 0
'pointerOffset 1
'pointers null))
(check-exn exn:fail:contract? (λ () (encode (+xpointer uint8 'void) 44 #:parent parent)))))
(check-exn exn:fail:contract? (λ () (encode (x:pointer uint8 'void) 44 #:parent parent)))))

@ -13,36 +13,36 @@ https://github.com/mbutterick/restructure/blob/master/test/Reserved.coffee
(test-case
"reserved: size should have a default count of 1"
(check-equal? (size (+xreserved uint8)) 1))
(check-equal? (size (x:reserved uint8)) 1))
(test-case
"reserved: size should allow custom counts and types"
(check-equal? (size (+xreserved uint16be 10)) 20))
(check-equal? (size (x:reserved uint16be 10)) 20))
(test-case
"reserved: should decode"
(parameterize ([current-input-port (open-input-bytes (bytes 0 0))])
(define reserved (+xreserved uint16be))
(define reserved (x:reserved uint16be))
(check-equal? (decode reserved) (void))
(check-equal? (pos (current-input-port)) 2)))
(test-case
"reserved: should decode with post-decode"
(parameterize ([current-input-port (open-input-bytes (bytes 0 0))])
(define reserved (+xreserved uint16be #:post-decode (λ (val) 42)))
(define reserved (x:reserved uint16be #:post-decode (λ (val) 42)))
(check-equal? (decode reserved) 42)
(check-equal? (pos (current-input-port)) 2)))
(test-case
"reserved: should encode"
(parameterize ([current-output-port (open-output-bytes)])
(define reserved (+xreserved uint16be))
(define reserved (x:reserved uint16be))
(encode reserved #f)
(check-equal? (get-output-bytes (current-output-port)) (bytes 0 0))))
(test-case
"reserved: should encode with pre-encode"
(parameterize ([current-output-port (open-output-bytes)])
(define reserved (+xreserved uint32be #:pre-encode (λ (val) 42)))
(define reserved (x:reserved uint32be #:pre-encode (λ (val) 42)))
(encode reserved #f)
(check-equal? (get-output-bytes (current-output-port)) (bytes 0 0 0 0))))

@ -15,110 +15,110 @@ https://github.com/mbutterick/restructure/blob/master/test/String.coffee
(test-case
"string: decode fixed length"
(parameterize ([current-input-port (open-input-bytes #"testing")])
(check-equal? (decode (+xstring 7)) "testing")))
(check-equal? (decode (x:string 7)) "testing")))
(test-case
"string: decode fixed length with post-decode"
(parameterize ([current-input-port (open-input-bytes #"testing")])
(define xs (+xstring 7 #:post-decode (λ (val) "ring a ding")))
(define xs (x:string 7 #:post-decode (λ (val) "ring a ding")))
(check-equal? (decode xs) "ring a ding")))
(test-case
"string: decode length from parent key"
(parameterize ([current-input-port (open-input-bytes #"testing")])
(check-equal? (decode (+xstring 'len) (current-input-port) #:parent (mhash 'len 7)) "testing")))
(check-equal? (decode (x:string 'len) (current-input-port) #:parent (mhash 'len 7)) "testing")))
(test-case
"string: decode length as number before string"
(parameterize ([current-input-port (open-input-bytes #"\x07testing")])
(check-equal? (decode (+xstring uint8) (current-input-port) #:parent (mhash 'len 7)) "testing")))
(check-equal? (decode (x:string uint8) (current-input-port) #:parent (mhash 'len 7)) "testing")))
(test-case
"string: decode utf8"
(parameterize ([current-input-port (open-input-bytes (string->bytes/utf-8 "🍻"))])
(check-equal? (decode (+xstring 4 'utf8)) "🍻")))
(check-equal? (decode (x:string 4 'utf8)) "🍻")))
(test-case
"string: decode encoding computed from function"
(parameterize ([current-input-port (open-input-bytes (string->bytes/utf-8 "🍻"))])
(check-equal? (decode (+xstring 4 (λ _ 'utf8))) "🍻")))
(check-equal? (decode (x:string 4 (λ _ 'utf8))) "🍻")))
(test-case
"string: decode null-terminated string and read past terminator"
(parameterize ([current-input-port (open-input-bytes (string->bytes/utf-8 "🍻\x00"))])
(check-equal? (decode (+xstring #f 'utf8)) "🍻")
(check-equal? (decode (x:string #f 'utf8)) "🍻")
(check-equal? (pos (current-input-port)) 5)))
(test-case
"string: decode remainder of buffer when null-byte missing"
(parameterize ([current-input-port (open-input-bytes (string->bytes/utf-8 "🍻"))])
(check-equal? (decode (+xstring #f 'utf8)) "🍻")))
(check-equal? (decode (x:string #f 'utf8)) "🍻")))
(test-case
"string: size should use string length"
(check-equal? (size (+xstring 7) "testing") 7))
(check-equal? (size (x:string 7) "testing") 7))
(test-case
"string: size should use correct encoding"
(check-equal? (size (+xstring 10 'utf8) "🍻") 4))
(check-equal? (size (x:string 10 'utf8) "🍻") 4))
(test-case
"string: size should use encoding from function"
(check-equal? (size (+xstring 10 (λ _ 'utf8)) "🍻") 4))
(check-equal? (size (x:string 10 (λ _ 'utf8)) "🍻") 4))
(test-case
"string: should add size of length field before string"
(check-equal? (size (+xstring uint8 'utf8) "🍻") 5))
(check-equal? (size (x:string uint8 'utf8) "🍻") 5))
; todo: it "should work with utf16be encoding"
(test-case
"string: size should take null-byte into account"
(check-equal? (size (+xstring #f 'utf8) "🍻") 5))
(check-equal? (size (x:string #f 'utf8) "🍻") 5))
(test-case
"string: size should use defined length if no value given"
(check-equal? (size (+xstring 10)) 10))
(check-equal? (size (x:string 10)) 10))
(test-case
"string: encode using string length"
(parameterize ([current-output-port (open-output-bytes)])
(encode (+xstring 7) "testing")
(encode (x:string 7) "testing")
(check-equal? (get-output-bytes (current-output-port)) #"testing")))
(test-case
"string: encode using string length and pre-encode"
(parameterize ([current-output-port (open-output-bytes)])
(define xs (+xstring 7 #:pre-encode (λ (val) (list->string (reverse (string->list val))))))
(define xs (x:string 7 #:pre-encode (λ (val) (list->string (reverse (string->list val))))))
(encode xs "testing")
(check-equal? (get-output-bytes (current-output-port)) #"gnitset")))
(test-case
"string: encode length as number before string"
(parameterize ([current-output-port (open-output-bytes)])
(encode (+xstring uint8) "testing")
(encode (x:string uint8) "testing")
(check-equal? (get-output-bytes (current-output-port)) #"\x07testing")))
(test-case
"string: encode length as number before string utf8"
(parameterize ([current-output-port (open-output-bytes)])
(encode (+xstring uint8 'utf8) "testing 😜")
(encode (x:string uint8 'utf8) "testing 😜")
(check-equal? (get-output-bytes (current-output-port)) (string->bytes/utf-8 "\x0ctesting 😜"))))
(test-case
"string: encode utf8"
(parameterize ([current-output-port (open-output-bytes)])
(encode (+xstring 4 'utf8) "🍻" )
(encode (x:string 4 'utf8) "🍻" )
(check-equal? (get-output-bytes (current-output-port)) (string->bytes/utf-8 "🍻"))))
(test-case
"string: encode encoding computed from function"
(parameterize ([current-output-port (open-output-bytes)])
(encode (+xstring 4 (λ _ 'utf8)) "🍻")
(encode (x:string 4 (λ _ 'utf8)) "🍻")
(check-equal? (get-output-bytes (current-output-port)) (string->bytes/utf-8 "🍻"))))
(test-case
"string: encode null-terminated string"
(parameterize ([current-output-port (open-output-bytes)])
(encode (+xstring #f 'utf8) "🍻" )
(encode (x:string #f 'utf8) "🍻" )
(check-equal? (get-output-bytes (current-output-port)) (string->bytes/utf-8 "🍻\x00"))))

@ -18,57 +18,57 @@ https://github.com/mbutterick/restructure/blob/master/test/Struct.coffee
"struct: decode into an object"
(parameterize ([current-input-port (open-input-bytes #"\x05roxyb\x15")])
(check-equal?
(decode (+xstruct 'name (+xstring #:length uint8) 'age uint8))
(decode (x:struct 'name (x:string #:length uint8) 'age uint8))
(mhasheq 'name "roxyb" 'age 21))))
(test-case
"struct: decode with process hook"
(parameterize ([current-input-port (open-input-bytes #"\x05roxyb\x20")])
(define struct (+xstruct #:post-decode (λ (o) (dict-set! o 'canDrink (>= (dict-ref o 'age) 21)) o)
'name (+xstring #:length uint8) 'age uint8))
(define struct (x:struct #:post-decode (λ (o) (dict-set! o 'canDrink (>= (dict-ref o 'age) 21)) o)
'name (x:string #:length uint8) 'age uint8))
(check-equal? (decode struct)
(mhasheq 'name "roxyb" 'age 32 'canDrink #t))))
(test-case
"struct: decode supports function keys"
(parameterize ([current-input-port (open-input-bytes #"\x05roxyb\x20")])
(define struct (+xstruct 'name (+xstring #:length uint8) 'age uint8 'canDrink (λ (o) (>= (dict-ref o 'age) 21))))
(define struct (x:struct 'name (x:string #:length uint8) 'age uint8 'canDrink (λ (o) (>= (dict-ref o 'age) 21))))
(check-equal? (decode struct)
(mhasheq 'name "roxyb" 'age 32 'canDrink #t))))
(test-case
"struct: compute the correct size"
(check-equal? (size (+xstruct 'name (+xstring #:length uint8) 'age uint8)
(check-equal? (size (x:struct 'name (x:string #:length uint8) 'age uint8)
(hasheq 'name "roxyb" 'age 32)) 7))
(test-case
"struct: compute the correct size with pointers"
(check-equal? (size (+xstruct 'name (+xstring #:length uint8)
(check-equal? (size (x:struct 'name (x:string #:length uint8)
'age uint8
'ptr (+xpointer #:type (+xstring #:length uint8)))
'ptr (x:pointer #:type (x:string #:length uint8)))
(mhash 'name "roxyb" 'age 21 'ptr "hello")) 14))
(test-case
"struct: get the correct size when no value is given"
(check-equal? (size (+xstruct 'name (+xstring 4) 'age uint8)) 5))
(check-equal? (size (x:struct 'name (x:string 4) 'age uint8)) 5))
(test-case
"struct: throw when getting non-fixed length size and no value is given"
(check-exn exn:fail:contract? (λ () (size (+xstruct 'name (+xstring #:length uint8) 'age uint8)))))
(check-exn exn:fail:contract? (λ () (size (x:struct 'name (x:string #:length uint8) 'age uint8)))))
(test-case
"struct: encode objects to buffers"
(parameterize ([current-input-port (open-input-bytes #"\x05roxyb\x15")])
(check-equal? (decode (+xstruct 'name (+xstring #:length uint8) 'age uint8))
(check-equal? (decode (x:struct 'name (x:string #:length uint8) 'age uint8))
(mhasheq 'name "roxyb" 'age 21))))
(test-case
"struct: support pre-encode hook"
(parameterize ([current-output-port (open-output-bytes)])
(define struct (+xstruct #:pre-encode (λ (val)
(define struct (x:struct #:pre-encode (λ (val)
(dict-set! val 'nameLength (string-length (dict-ref val 'name))) val)
'nameLength uint8
'name (+xstring 'nameLength)
'name (x:string 'nameLength)
'age uint8))
(encode struct (mhasheq 'name "roxyb" 'age 21))
(check-equal? (get-output-bytes (current-output-port)) #"\x05roxyb\x15")))
@ -76,8 +76,8 @@ https://github.com/mbutterick/restructure/blob/master/test/Struct.coffee
(test-case
"struct: encode pointer data after structure"
(parameterize ([current-output-port (open-output-bytes)])
(define struct (+xstruct 'name (+xstring #:length uint8)
(define struct (x:struct 'name (x:string #:length uint8)
'age uint8
'ptr (+xpointer #:type (+xstring #:length uint8))))
'ptr (x:pointer #:type (x:string #:length uint8))))
(encode struct (hasheq 'name "roxyb" 'age 21 'ptr "hello"))
(check-equal? (get-output-bytes (current-output-port)) #"\x05roxyb\x15\x08\x05hello")))

@ -17,11 +17,11 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
(test-case
"versioned struct: decode should get version from number type"
(let ([vstruct (+xversioned-struct uint8
(let ([vstruct (x:versioned-struct uint8
(dictify
0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii)
0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii)
'age uint8)
1 (+xstruct 'name (+xstring #:length uint8 #:encoding 'utf8)
1 (x:struct 'name (x:string #:length uint8 #:encoding 'utf8)
'age uint8
'gender uint8)))])
(parameterize ([current-input-port (open-input-bytes #"\x00\x05roxyb\x15")])
@ -31,11 +31,11 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
(test-case
"versioned struct: decode should throw for unknown version"
(let ([vstruct (+xversioned-struct uint8
(let ([vstruct (x:versioned-struct uint8
(dictify
0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii)
0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii)
'age uint8)
1 (+xstruct 'name (+xstring #:length uint8 #:encoding 'utf8)
1 (x:struct 'name (x:string #:length uint8 #:encoding 'utf8)
'age uint8
'gender uint8)))])
(parameterize ([current-input-port (open-input-bytes #"\x05\x05roxyb\x15")])
@ -43,12 +43,12 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
(test-case
"versioned struct: decode should support common header block"
(let ([vstruct (+xversioned-struct uint8
(let ([vstruct (x:versioned-struct uint8
(dictify
'header (dictify 'age uint8
'alive uint8)
0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii))
1 (+xstruct 'name (+xstring #:length uint8 #:encoding 'utf8)
0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii))
1 (x:struct 'name (x:string #:length uint8 #:encoding 'utf8)
'gender uint8)))])
(parameterize ([current-input-port (open-input-bytes #"\x00\x15\x01\x05roxyb")])
(check-equal? (decode vstruct) (mhasheq 'name "roxyb"
@ -64,11 +64,11 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
(test-case
"versioned struct: decode should support parent version key"
(let ([vstruct (+xversioned-struct 'version
(let ([vstruct (x:versioned-struct 'version
(dictify
0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii)
0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii)
'age uint8)
1 (+xstruct 'name (+xstring #:length uint8 #:encoding 'utf8)
1 (x:struct 'name (x:string #:length uint8 #:encoding 'utf8)
'age uint8
'gender uint8)))])
(parameterize ([current-input-port (open-input-bytes #"\x05roxyb\x15")])
@ -80,14 +80,14 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
(test-case
"versioned struct: decode should support sub versioned structs"
(let ([vstruct (+xversioned-struct uint8
(let ([vstruct (x:versioned-struct uint8
(dictify
0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii)
0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii)
'age uint8)
1 (+xversioned-struct uint8
1 (x:versioned-struct uint8
(dictify
0 (dictify 'name (+xstring uint8))
1 (dictify 'name (+xstring uint8)
0 (dictify 'name (x:string uint8))
1 (dictify 'name (x:string uint8)
'isDessert uint8)))))])
(parameterize ([current-input-port (open-input-bytes #"\x00\x05roxyb\x15")])
(check-equal? (decode vstruct #:parent (mhash 'version 0))
@ -101,12 +101,12 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
(test-case
"versioned struct: decode should support process hook"
(let ([vstruct (+xversioned-struct #:post-decode (λ (val) (dict-set! val 'processed "true") val)
(let ([vstruct (x:versioned-struct #:post-decode (λ (val) (dict-set! val 'processed "true") val)
uint8
(dictify
0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii)
0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii)
'age uint8)
1 (+xstruct 'name (+xstring #:length uint8 #:encoding 'utf8)
1 (x:struct 'name (x:string #:length uint8 #:encoding 'utf8)
'age uint8
'gender uint8)))])
(parameterize ([current-input-port (open-input-bytes #"\x00\x05roxyb\x15")])
@ -115,11 +115,11 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
(test-case
"versioned struct: size should compute the correct size"
(let ([vstruct (+xversioned-struct uint8
(let ([vstruct (x:versioned-struct uint8
(dictify
0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii)
0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii)
'age uint8)
1 (+xstruct 'name (+xstring #:length uint8 #:encoding 'utf8)
1 (x:struct 'name (x:string #:length uint8 #:encoding 'utf8)
'age uint8
'gender uint8)))])
(check-equal? (size vstruct (mhasheq 'name "roxyb"
@ -132,37 +132,37 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
(test-case
"versioned struct: size should throw for unknown version"
(let ([vstruct (+xversioned-struct uint8
(let ([vstruct (x:versioned-struct uint8
(dictify
0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii)
0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii)
'age uint8)
1 (+xstruct 'name (+xstring #:length uint8 #:encoding 'utf8)
1 (x:struct 'name (x:string #:length uint8 #:encoding 'utf8)
'age uint8
'gender uint8)))])
(check-exn exn:fail:contract? (λ () (size vstruct (mhasheq 'name "roxyb" 'age 21 'version 5))))))
(test-case
"versioned struct: size should support common header block"
(let ([struct (+xversioned-struct uint8
(let ([struct (x:versioned-struct uint8
(dictify
'header (dictify 'age uint8
'alive uint8)
0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii))
1 (+xstruct 'name (+xstring #:length uint8 #:encoding 'utf8)
0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii))
1 (x:struct 'name (x:string #:length uint8 #:encoding 'utf8)
'gender uint8)))])
(check-equal? (size struct (mhasheq 'name "roxyb" 'age 21 'alive 1 'version 0)) 9)
(check-equal? (size struct (mhasheq 'name "roxyb 🤘" 'gender 0 'age 21 'alive 1 'version 1)) 15)))
(test-case
"versioned struct: size should compute the correct size with pointers"
(let ([vstruct (+xversioned-struct uint8
(let ([vstruct (x:versioned-struct uint8
(dictify
0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii)
0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii)
'age uint8)
1 (+xstruct 'name (+xstring #:length uint8 #:encoding 'utf8)
1 (x:struct 'name (x:string #:length uint8 #:encoding 'utf8)
'age uint8
'ptr (+xpointer #:offset-type uint8
#:type (+xstring uint8)))))])
'ptr (x:pointer #:offset-type uint8
#:type (x:string uint8)))))])
(check-equal? (size vstruct (mhasheq 'name "roxyb"
'age 21
'version 1
@ -170,22 +170,22 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
(test-case
"versioned struct: size should throw if no value is given"
(let ([vstruct (+xversioned-struct uint8
(let ([vstruct (x:versioned-struct uint8
(dictify
0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii)
0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii)
'age uint8)
1 (+xstruct 'name (+xstring #:length uint8 #:encoding 'utf8)
1 (x:struct 'name (x:string #:length uint8 #:encoding 'utf8)
'age uint8
'gender uint8)))])
(check-exn exn:fail:contract? (λ () (size vstruct)))))
(test-case
"versioned struct: encode should encode objects to buffers"
(let ([vstruct (+xversioned-struct uint8
(let ([vstruct (x:versioned-struct uint8
(dictify
0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii)
0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii)
'age uint8)
1 (+xstruct 'name (+xstring #:length uint8 #:encoding 'utf8)
1 (x:struct 'name (x:string #:length uint8 #:encoding 'utf8)
'age uint8
'gender uint8)))]
[op (open-output-bytes)])
@ -195,11 +195,11 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
(test-case
"versioned struct: encode should throw for unknown version"
(let ([vstruct (+xversioned-struct uint8
(let ([vstruct (x:versioned-struct uint8
(dictify
0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii)
0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii)
'age uint8)
1 (+xstruct 'name (+xstring #:length uint8 #:encoding 'utf8)
1 (x:struct 'name (x:string #:length uint8 #:encoding 'utf8)
'age uint8
'gender uint8)))]
[op (open-output-bytes)])
@ -207,12 +207,12 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
(test-case
"versioned struct: encode should support common header block"
(let ([vstruct (+xversioned-struct uint8
(let ([vstruct (x:versioned-struct uint8
(dictify
'header (dictify 'age uint8
'alive uint8)
0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii))
1 (+xstruct 'name (+xstring #:length uint8 #:encoding 'utf8)
0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii))
1 (x:struct 'name (x:string #:length uint8 #:encoding 'utf8)
'gender uint8)))]
[op (open-output-bytes)])
(encode vstruct (mhasheq 'name "roxyb" 'age 21 'alive 1 'version 0) op)
@ -221,14 +221,14 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
(test-case
"versioned struct: encode should encode pointer data after structure"
(let ([vstruct (+xversioned-struct uint8
(let ([vstruct (x:versioned-struct uint8
(dictify
0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii)
0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii)
'age uint8)
1 (+xstruct 'name (+xstring #:length uint8 #:encoding 'utf8)
1 (x:struct 'name (x:string #:length uint8 #:encoding 'utf8)
'age uint8
'ptr (+xpointer #:offset-type uint8
#:type (+xstring uint8)))))]
'ptr (x:pointer #:offset-type uint8
#:type (x:string uint8)))))]
[op (open-output-bytes)])
(encode vstruct (mhasheq 'version 1 'name "roxyb" 'age 21 'ptr "hello") op)
@ -236,11 +236,11 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
#;(test-case
"versioned struct: encode should support preEncode hook"
(let ([vstruct (+xversioned-struct uint8
(let ([vstruct (x:versioned-struct uint8
(dictify
0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii)
0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii)
'age uint8)
1 (+xstruct 'name (+xstring #:length uint8 #:encoding 'utf8)
1 (x:struct 'name (x:string #:length uint8 #:encoding 'utf8)
'age uint8
'gender uint8)))]
[op (open-output-bytes)])

@ -102,7 +102,7 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
(define (xversioned-struct? x) (is-a? x x:versioned-struct%))
(define (+xversioned-struct type [versions (dictify)]
(define (x:versioned-struct type [versions (dictify)]
#:pre-encode [pre-proc #f]
#:post-decode [post-proc #f])
(new (generate-subclass x:versioned-struct% pre-proc post-proc) [type type] [versions versions][fields #f]))

Loading…
Cancel
Save