mbutterick
/
typesetting
2
1
Fork 0
Code Issues 13 Pull Requests Projects Releases Wiki Activity

renames

Browse Source
main
Matthew Butterick 5 years ago
parent af8380e46d
commit aa73861282
15 changed files with 514 additions and 225 deletions
Show Stats Download Patch File Download Diff File

9
xenomorph/xenomorph/buffer.rkt → xenomorph/xenomorph/bytes.rkt
Unescape Escape View File

@ -7,7 +7,7 @@ approximates
https://github.com/mbutterick/restructure/blob/master/src/Buffer.coffee https://github.com/mbutterick/restructure/blob/master/src/Buffer.coffee
|# |#
(define x:buffer% (define x:bytes%
(class x:base% (class x:base%
(super-new) (super-new)
(init-field [(@len len)]) (init-field [(@len len)])
@ -30,10 +30,13 @@ https://github.com/mbutterick/restructure/blob/master/src/Buffer.coffee
[#false (resolve-length @len val parent)] [#false (resolve-length @len val parent)]
[_ (raise-argument-error 'x:buffer-size "bytes or #f" val)])))) [_ (raise-argument-error 'x:buffer-size "bytes or #f" val)]))))
(define (x:buffer [len-arg #f] (define (x:bytes [len-arg #f]
#:length [len-kwarg #f] #:length [len-kwarg #f]
#:pre-encode [pre-proc #f] #:pre-encode [pre-proc #f]
#:post-decode [post-proc #f] #:post-decode [post-proc #f]
#:base-class [base-class x:buffer%]) #:base-class [base-class x:bytes%])
(define len (or len-arg len-kwarg #xffff)) (define len (or len-arg len-kwarg #xffff))
(new (generate-subclass base-class pre-proc post-proc) [len len])) (new (generate-subclass base-class pre-proc post-proc) [len len]))
(define x:buffer% x:bytes%)
(define x:buffer x:bytes)

20
xenomorph/xenomorph/array.rkt → xenomorph/xenomorph/list.rkt
Unescape Escape View File

@ -11,7 +11,7 @@ approximates
https://github.com/mbutterick/restructure/blob/master/src/Array.coffee https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
|# |#
(define x:array% (define x:list%
(class x:base% (class x:base%
(super-new) (super-new)
(init-field [(@type type)] [(@len len)] [(@count-bytes? count-bytes?)]) (init-field [(@type type)] [(@len len)] [(@count-bytes? count-bytes?)])
@ -86,22 +86,26 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
(define size (send @type x:size #f parent)) (define size (send @type x:size #f parent))
(* size count)])))) (* size count)]))))
(define (x:array [type-arg #f] [len-arg #f] [length-type-arg 'count] (define (x:list [type-arg #f] [len-arg #f] [length-type-arg 'count]
#:type [type-kwarg #f] #:type [type-kwarg #f]
#:length [len-kwarg #f] #:length [len-kwarg #f]
#:count-bytes [count-bytes? #f] #:count-bytes [count-bytes? #f]
#:pre-encode [pre-proc #f] #:pre-encode [pre-proc #f]
#:post-decode [post-proc #f] #:post-decode [post-proc #f]
#:base-class [base-class x:array%]) #:base-class [base-class x:list%])
(new (generate-subclass base-class pre-proc post-proc) [type (or type-arg type-kwarg)] (new (generate-subclass base-class pre-proc post-proc) [type (or type-arg type-kwarg)]
[len (or len-arg len-kwarg)] [len (or len-arg len-kwarg)]
[count-bytes? count-bytes?])) [count-bytes? count-bytes?]))
(define (x:array? x) (is-a? x x:array%)) (define (x:list? x) (is-a? x x:list%))
(define x:array% x:list%)
(define x:array x:list)
(define x:array? x:list?)
(module+ test (module+ test
(require rackunit "base.rkt") (require rackunit "base.rkt")
(check-equal? (decode (x:array uint16be 3) #"ABCDEF") '(16706 17220 17734)) (check-equal? (decode (x:list uint16be 3) #"ABCDEF") '(16706 17220 17734))
(check-equal? (encode (x:array uint16be 3) '(16706 17220 17734) #f) #"ABCDEF") (check-equal? (encode (x:list uint16be 3) '(16706 17220 17734) #f) #"ABCDEF")
(check-equal? (size (x:array uint16be) '(1 2 3)) 6) (check-equal? (size (x:list uint16be) '(1 2 3)) 6)
(check-equal? (size (x:array doublebe) '(1 2 3 4 5)) 40)) (check-equal? (size (x:list doublebe) '(1 2 3 4 5)) 40))

10
xenomorph/xenomorph/main.rkt
Unescape Escape View File

@ -4,17 +4,19 @@
(define-syntax-rule (r+p ID ...) (define-syntax-rule (r+p ID ...)
(begin (require ID ...) (provide (all-from-out ID ...)))) (begin (require ID ...) (provide (all-from-out ID ...))))
(r+p "array.rkt" (r+p "bitfield.rkt"
"bitfield.rkt" "bytes.rkt"
"buffer.rkt"
"enum.rkt" "enum.rkt"
"base.rkt" "base.rkt"
"lazy-array.rkt" "list.rkt"
"number.rkt" "number.rkt"
"optional.rkt" "optional.rkt"
"pointer.rkt" "pointer.rkt"
"reserved.rkt" "reserved.rkt"
"string.rkt" "string.rkt"
"stream.rkt"
"struct.rkt" "struct.rkt"
"symbol.rkt"
"vector.rkt"
"versioned-struct.rkt" "versioned-struct.rkt"
"util.rkt") "util.rkt")

17
xenomorph/xenomorph/lazy-array.rkt → xenomorph/xenomorph/stream.rkt
Unescape Escape View File

@ -1,6 +1,6 @@
#lang racket/base #lang racket/base
(require racket/class (require racket/class
"base.rkt" "util.rkt" "number.rkt" "array.rkt" racket/stream sugar/unstable/dict) "base.rkt" "util.rkt" "number.rkt" "list.rkt" racket/stream sugar/unstable/dict)
(provide (all-defined-out)) (provide (all-defined-out))
#| #|
@ -8,8 +8,8 @@ approximates
https://github.com/mbutterick/restructure/blob/master/src/LazyArray.coffee https://github.com/mbutterick/restructure/blob/master/src/LazyArray.coffee
|# |#
(define x:lazy-array% (define x:stream%
(class x:array% (class x:list%
(super-new) (super-new)
(inherit-field [@type type] [@len len]) (inherit-field [@type type] [@len len])
@ -38,29 +38,32 @@ https://github.com/mbutterick/restructure/blob/master/src/LazyArray.coffee
(define/override (x:size [val #f] [parent #f]) (define/override (x:size [val #f] [parent #f])
(super x:size (if (stream? val) (stream->list val) val) parent)))) (super x:size (if (stream? val) (stream->list val) val) parent))))
(define (x:lazy-array [type-arg #f] [len-arg #f] (define (x:stream [type-arg #f] [len-arg #f]
#:type [type-kwarg #f] #:type [type-kwarg #f]
#:length [len-kwarg #f] #:length [len-kwarg #f]
#:pre-encode [pre-proc #f] #:pre-encode [pre-proc #f]
#:post-decode [post-proc #f] #:post-decode [post-proc #f]
#:base-class [base-class x:lazy-array%]) #:base-class [base-class x:stream%])
(define type (or type-arg type-kwarg)) (define type (or type-arg type-kwarg))
(define len (or len-arg len-kwarg)) (define len (or len-arg len-kwarg))
(new (generate-subclass base-class pre-proc post-proc) [type type] (new (generate-subclass base-class pre-proc post-proc) [type type]
[len len] [len len]
[count-bytes? #false])) [count-bytes? #false]))
(define x:lazy-array% x:stream%)
(define x:lazy-array x:stream)
(module+ test (module+ test
(require rackunit "number.rkt" "base.rkt") (require rackunit "number.rkt" "base.rkt")
(define bstr #"ABCD1234") (define bstr #"ABCD1234")
(define ds (open-input-bytes bstr)) (define ds (open-input-bytes bstr))
(define la (x:lazy-array uint8 4)) (define la (x:stream uint8 4))
(define ila (decode la ds)) (define ila (decode la ds))
(check-equal? (pos ds) 4) (check-equal? (pos ds) 4)
(check-equal? (stream-ref ila 1) 66) (check-equal? (stream-ref ila 1) 66)
(check-equal? (stream-ref ila 3) 68) (check-equal? (stream-ref ila 3) 68)
(check-equal? (pos ds) 4) (check-equal? (pos ds) 4)
(check-equal? (stream->list ila) '(65 66 67 68)) (check-equal? (stream->list ila) '(65 66 67 68))
(define la2 (x:lazy-array int16be (λ (t) 4))) (define la2 (x:stream int16be (λ (t) 4)))
(check-equal? (encode la2 '(1 2 3 4) #f) #"\0\1\0\2\0\3\0\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))) (check-equal? (stream->list (decode la2 (open-input-bytes #"\0\1\0\2\0\3\0\4"))) '(1 2 3 4)))

36
xenomorph/xenomorph/string.rkt
Unescape Escape View File

@ -89,39 +89,3 @@ https://github.com/mbutterick/restructure/blob/master/src/String.coffee
(define len (or len-arg len-kwarg)) (define len (or len-arg len-kwarg))
(define encoding (or enc-arg enc-kwarg 'ascii)) (define encoding (or enc-arg enc-kwarg 'ascii))
(new (generate-subclass base-class pre-proc post-proc) [len len] [encoding encoding])) (new (generate-subclass base-class pre-proc post-proc) [len len] [encoding encoding]))
(define x:symbol%
(class x:string%
(super-new)
(inherit-field len encoding)
(define/override (pre-encode val)
(unless (or (string? val) (symbol? val))
(raise-argument-error 'xsymbol-encode "symbol or string" val))
(if (symbol? val) (symbol->string val) val))
(define/override (post-decode val) (string->symbol val))))
(define (x:symbol [len-arg #f] [enc-arg #f]
#:length [len-kwarg #f]
#:encoding [enc-kwarg #f]
#:pre-encode [pre-proc #f]
#:post-decode [post-proc #f]
#:base-class [base-class x:symbol%])
(define len (or len-arg len-kwarg))
(define encoding (or enc-arg enc-kwarg 'utf8))
(new (generate-subclass base-class pre-proc post-proc) [len len] [encoding encoding]))
(module+ test
(require rackunit "base.rkt")
(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 (x:string uint8 'utf8))
(check-equal? (decode S #"\2BCDEF") "BC")
(check-equal? (encode S "Mike" #f) #"\4Mike")
(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))))

38
xenomorph/xenomorph/symbol.rkt
Unescape Escape View File

@ -0,0 +1,38 @@
#lang racket/base
(require racket/class "base.rkt" "number.rkt" "string.rkt")
(provide (all-defined-out))
(define x:symbol%
(class x:string%
(super-new)
(define/override (pre-encode val)
(unless (or (string? val) (symbol? val))
(raise-argument-error 'x:symbol-encode "symbol or string" val))
(if (symbol? val) (symbol->string val) val))
(define/override (post-decode val) (string->symbol val))))
(define (x:symbol [len-arg #f] [enc-arg #f]
#:length [len-kwarg #f]
#:encoding [enc-kwarg #f]
#:pre-encode [pre-proc #f]
#:post-decode [post-proc #f]
#:base-class [base-class x:symbol%])
(define len (or len-arg len-kwarg))
(define encoding (or enc-arg enc-kwarg 'utf8))
(new (generate-subclass base-class pre-proc post-proc) [len len] [encoding encoding]))
(module+ test
(require rackunit "base.rkt")
(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 (x:string uint8 'utf8))
(check-equal? (decode S #"\2BCDEF") "BC")
(check-equal? (encode S "Mike" #f) #"\4Mike")
(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))))

116
xenomorph/xenomorph/test/array-test.rkt
Unescape Escape View File

@ -1,116 +0,0 @@
#lang racket/base
(require rackunit
racket/class
"../array.rkt"
"../struct.rkt"
"../number.rkt"
"../pointer.rkt"
"../base.rkt"
sugar/unstable/dict)
#|
approximates
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 (x:array #:type uint8 #:length 4)) '(1 2 3 4))))
(test-case
"array: decode nested"
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(check-equal? (decode (x:array #:type (x:struct 'foo uint8) #:length 4))
(list (mhasheq 'foo 1)
(mhasheq 'foo 2)
(mhasheq 'foo 3)
(mhasheq 'foo 4)))))
(test-case
"array: decode with post-decode"
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(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 (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 (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 (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 (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 (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 (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 (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 (x:array #:type uint8) (current-input-port) #:parent (mhash x:length-key 4 x:start-offset-key 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 (x:array #:type uint8) (current-input-port) #:parent (mhash x:length-key 0 x:start-offset-key 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 (x:array #:type uint8)) '(1 2 3 4 ))))
(test-case
"array: use array length"
(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 (x:array #:type uint8 #:length uint8) '(1 2 3 4)) 5))
(test-case
"array: use defined length if no value given"
(check-equal? (size (x:array #:type uint8 #:length 10)) 10))
(test-case
"array: encode using array length"
(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 (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 (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 (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)))

38
xenomorph/xenomorph/test/buffer-test.rkt → xenomorph/xenomorph/test/bytes-test.rkt
Unescape Escape View File

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

116
xenomorph/xenomorph/test/list-test.rkt
Unescape Escape View File

@ -0,0 +1,116 @@
#lang racket/base
(require rackunit
racket/class
"../list.rkt"
"../struct.rkt"
"../number.rkt"
"../pointer.rkt"
"../base.rkt"
sugar/unstable/dict)
#|
approximates
https://github.com/mbutterick/restructure/blob/master/test/Array.coffee
|#
(test-case
"list: decode fixed length"
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(check-equal? (decode (x:list #:type uint8 #:length 4)) '(1 2 3 4))))
(test-case
"list: decode nested"
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(check-equal? (decode (x:list #:type (x:struct 'foo uint8) #:length 4))
(list (mhasheq 'foo 1)
(mhasheq 'foo 2)
(mhasheq 'foo 3)
(mhasheq 'foo 4)))))
(test-case
"list: decode with post-decode"
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(define xa (x:list #:type uint8 #:length 4 #:post-decode (λ (val) (map (λ (x) (* 2 x)) val))))
(check-equal? (decode xa) '(2 4 6 8))))
(test-case
"list: decode fixed number of bytes"
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(check-equal? (decode (x:list #:type uint16be #:length 4 #:count-bytes #t)) '(258 772))))
(test-case
"list: decode length from parent key"
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(check-equal? (decode (x:list #:type uint8 #:length 'len) (current-input-port) #:parent (mhash 'len 4)) '(1 2 3 4))))
(test-case
"list: decode byte count from parent key"
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(check-equal? (decode (x:list #:type uint16be #:length 'len #:count-bytes #t) (current-input-port) #:parent (mhash 'len 4)) '(258 772))))
(test-case
"list: decode length as number before array"
(parameterize ([current-input-port (open-input-bytes (bytes 4 1 2 3 4 5))])
(check-equal? (decode (x:list #:type uint8 #:length uint8)) '(1 2 3 4))))
(test-case
"list: decode byte count as number before array"
(parameterize ([current-input-port (open-input-bytes (bytes 4 1 2 3 4 5))])
(check-equal? (decode (x:list #:type uint16be #:length uint8 #:count-bytes #t)) '(258 772))))
(test-case
"list: decode length from function"
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(check-equal? (decode (x:list #:type uint8 #:length (λ _ 4))) '(1 2 3 4))))
(test-case
"list: decode byte count from function"
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(check-equal? (decode (x:list #:type uint16be #:length (λ _ 4) #:count-bytes #t)) '(258 772))))
(test-case
"list: 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 (x:list #:type uint8) (current-input-port) #:parent (mhash x:length-key 4 x:start-offset-key 0)) '(1 2 3 4))))
(test-case
"list: 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 (x:list #:type uint8) (current-input-port) #:parent (mhash x:length-key 0 x:start-offset-key 0)) '(1 2 3 4 5))))
(test-case
"list: 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 (x:list #:type uint8)) '(1 2 3 4 ))))
(test-case
"list: use array length"
(check-equal? (size (x:list #:type uint8 #:length 10) '(1 2 3 4)) 4))
(test-case
"list: add size of length field before string"
(check-equal? (size (x:list #:type uint8 #:length uint8) '(1 2 3 4)) 5))
(test-case
"list: use defined length if no value given"
(check-equal? (size (x:list #:type uint8 #:length 10)) 10))
(test-case
"list: encode using array length"
(check-equal? (encode (x:list #:type uint8 #:length 10) '(1 2 3 4) #f) (bytes 1 2 3 4)))
(test-case
"list: encode with pre-encode"
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(define xa (x:list #: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
"list: encode length as number before array"
(check-equal? (encode (x:list #:type uint8 #:length uint8) '(1 2 3 4) #f) (bytes 4 1 2 3 4)))
(test-case
"list: add pointers after array if length is encoded at start"
(check-equal? (encode (x:list #: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)))

10
xenomorph/xenomorph/test/main.rkt
Unescape Escape View File

@ -1,14 +1,16 @@
#lang racket/base #lang racket/base
(require "array-test.rkt" (require "bitfield-test.rkt"
"bitfield-test.rkt" "bytes-test.rkt"
"buffer-test.rkt"
"enum-test.rkt" "enum-test.rkt"
"lazy-array-test.rkt" "list-test.rkt"
"number-test.rkt" "number-test.rkt"
"optional-test.rkt" "optional-test.rkt"
"pointer-test.rkt" "pointer-test.rkt"
"reserved-test.rkt" "reserved-test.rkt"
"stream-test.rkt"
"string-test.rkt" "string-test.rkt"
"symbol-test.rkt"
"struct-test.rkt" "struct-test.rkt"
"vector-test.rkt"
"versioned-struct-test.rkt") "versioned-struct-test.rkt")

20
xenomorph/xenomorph/test/lazy-array-test.rkt → xenomorph/xenomorph/test/stream-test.rkt
Unescape Escape View File

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

120
xenomorph/xenomorph/test/symbol-test.rkt
Unescape Escape View File

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

117
xenomorph/xenomorph/test/vector-test.rkt
Unescape Escape View File

@ -0,0 +1,117 @@
#lang racket/base
(require rackunit
racket/class
racket/vector
"../vector.rkt"
"../struct.rkt"
"../number.rkt"
"../pointer.rkt"
"../base.rkt"
sugar/unstable/dict)
#|
approximates
https://github.com/mbutterick/restructure/blob/master/test/Array.coffee
|#
(test-case
"vector: decode fixed length"
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(check-equal? (decode (x:vector #:type uint8 #:length 4)) '#(1 2 3 4))))
(test-case
"vector: decode nested"
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(check-equal? (decode (x:vector #:type (x:struct 'foo uint8) #:length 4))
(vector (mhasheq 'foo 1)
(mhasheq 'foo 2)
(mhasheq 'foo 3)
(mhasheq 'foo 4)))))
(test-case
"vector: decode with post-decode"
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(define xa (x:vector #:type uint8 #:length 4 #:post-decode (λ (val) (vector-map (λ (x) (* 2 x)) val))))
(check-equal? (decode xa) '#(2 4 6 8))))
(test-case
"vector: decode fixed number of bytes"
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(check-equal? (decode (x:vector #:type uint16be #:length 4 #:count-bytes #t)) '#(258 772))))
(test-case
"vector: decode length from parent key"
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(check-equal? (decode (x:vector #:type uint8 #:length 'len) (current-input-port) #:parent (mhash 'len 4)) '#(1 2 3 4))))
(test-case
"vector: decode byte count from parent key"
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(check-equal? (decode (x:vector #:type uint16be #:length 'len #:count-bytes #t) (current-input-port) #:parent (mhash 'len 4)) '#(258 772))))
(test-case
"vector: decode length as number before array"
(parameterize ([current-input-port (open-input-bytes (bytes 4 1 2 3 4 5))])
(check-equal? (decode (x:vector #:type uint8 #:length uint8)) '#(1 2 3 4))))
(test-case
"vector: decode byte count as number before array"
(parameterize ([current-input-port (open-input-bytes (bytes 4 1 2 3 4 5))])
(check-equal? (decode (x:vector #:type uint16be #:length uint8 #:count-bytes #t)) '#(258 772))))
(test-case
"vector: decode length from function"
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(check-equal? (decode (x:vector #:type uint8 #:length (λ _ 4))) '#(1 2 3 4))))
(test-case
"vector: decode byte count from function"
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(check-equal? (decode (x:vector #:type uint16be #:length (λ _ 4) #:count-bytes #t)) '#(258 772))))
(test-case
"vector: 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 (x:vector #:type uint8) (current-input-port) #:parent (mhash x:length-key 4 x:start-offset-key 0)) '#(1 2 3 4))))
(test-case
"vector: 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 (x:vector #:type uint8) (current-input-port) #:parent (mhash x:length-key 0 x:start-offset-key 0)) '#(1 2 3 4 5))))
(test-case
"vector: 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 (x:vector #:type uint8)) '#(1 2 3 4 ))))
(test-case
"vector: use array length"
(check-equal? (size (x:vector #:type uint8 #:length 10) '#(1 2 3 4)) 4))
(test-case
"vector: add size of length field before string"
(check-equal? (size (x:vector #:type uint8 #:length uint8) '#(1 2 3 4)) 5))
(test-case
"vector: use defined length if no value given"
(check-equal? (size (x:vector #:type uint8 #:length 10)) 10))
(test-case
"vector: encode using array length"
(check-equal? (encode (x:vector #:type uint8 #:length 10) '#(1 2 3 4) #f) (bytes 1 2 3 4)))
(test-case
"vector: encode with pre-encode"
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(define xa (x:vector #:type uint8 #:length 4 #:pre-encode (λ (val) (vector-map (λ (x) (* 2 x)) val))))
(check-equal? (encode xa '#(1 2 3 4) #f) (bytes 2 4 6 8))))
(test-case
"vector: encode length as number before array"
(check-equal? (encode (x:vector #:type uint8 #:length uint8) '#(1 2 3 4) #f) (bytes 4 1 2 3 4)))
(test-case
"vector: add pointers after array if length is encoded at start"
(check-equal? (encode (x:vector #: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)))

40
xenomorph/xenomorph/vector.rkt
Unescape Escape View File

@ -0,0 +1,40 @@
#lang debug racket/base
(require racket/class
"base.rkt"
"number.rkt"
"util.rkt"
"list.rkt"
sugar/unstable/dict)
(provide (all-defined-out))
(define x:vector%
(class x:list%
(super-new)
(define/override (pre-encode val)
(unless (or (vector? val) (list? val))
(raise-argument-error 'x:vector-encode "vector or list" val))
(if (vector? val) (vector->list val) val))
(define/override (post-decode val) (list->vector val))))
(define (x:vector [type-arg #f] [len-arg #f] [length-type-arg 'count]
#:type [type-kwarg #f]
#:length [len-kwarg #f]
#:count-bytes [count-bytes? #f]
#:pre-encode [pre-proc #f]
#:post-decode [post-proc #f]
#:base-class [base-class x:vector%])
(new (generate-subclass base-class pre-proc post-proc) [type (or type-arg type-kwarg)]
[len (or len-arg len-kwarg)]
[count-bytes? count-bytes?]))
(define (x:vector? x) (is-a? x x:vector%))
(module+ test
(require rackunit)
(check-equal? (decode (x:vector uint16be 3) #"ABCDEF") '#(16706 17220 17734))
(check-equal? (encode (x:vector uint16be 3) '(16706 17220 17734) #f) #"ABCDEF")
(check-equal? (encode (x:vector uint16be 3) '#(16706 17220 17734) #f) #"ABCDEF")
(check-equal? (size (x:vector uint16be) '#(1 2 3)) 6)
(check-equal? (size (x:vector doublebe) '#(1 2 3 4 5)) 40))

22
xenomorph/xenomorph/versioned-struct.rkt
Unescape Escape View File

@ -42,19 +42,15 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
[_ (send @type x:decode port parent)])) [_ (send @type x:decode port parent)]))
(dict-set! res x:version-key which-version) (dict-set! res x:version-key which-version)
(cond (match (dict-ref @versions 'header #f)
[(dict-ref @versions 'header #f) [#false (void)]
=> (λ (header-val) (parse-fields port res header-val))]) [header-val (parse-fields port res header-val)])
(define field-object (match (dict-ref @versions which-version #f)
(cond [#false (raise-argument-error 'x:versioned-struct-decode
[(dict-ref @versions which-version #f) => values] (format "valid field version: ~v" (dict-keys @versions)) which-version)]
[else [(? x:versioned-struct? vs) (send vs x:decode port parent)]
(raise-argument-error 'x:versioned-struct-decode (format "valid field version: ~v" (dict-keys @versions)) which-version)])) [field-object (parse-fields port res field-object)]))
(match field-object
[(? x:versioned-struct?) (send field-object x:decode port parent)]
[_ (parse-fields port res field-object)]))
(define/override (pre-encode val) val) (define/override (pre-encode val) val)

Write Preview
Loading…
Cancel
Save