diff --git a/xenomorph/xenomorph/buffer.rkt b/xenomorph/xenomorph/bytes.rkt similarity index 88% rename from xenomorph/xenomorph/buffer.rkt rename to xenomorph/xenomorph/bytes.rkt index 13581d43..d5d29098 100644 --- a/xenomorph/xenomorph/buffer.rkt +++ b/xenomorph/xenomorph/bytes.rkt @@ -7,7 +7,7 @@ approximates https://github.com/mbutterick/restructure/blob/master/src/Buffer.coffee |# -(define x:buffer% +(define x:bytes% (class x:base% (super-new) (init-field [(@len len)]) @@ -30,10 +30,13 @@ https://github.com/mbutterick/restructure/blob/master/src/Buffer.coffee [#false (resolve-length @len val parent)] [_ (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] #:pre-encode [pre-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)) - (new (generate-subclass base-class pre-proc post-proc) [len len])) \ No newline at end of file + (new (generate-subclass base-class pre-proc post-proc) [len len])) + +(define x:buffer% x:bytes%) +(define x:buffer x:bytes) \ No newline at end of file diff --git a/xenomorph/xenomorph/array.rkt b/xenomorph/xenomorph/list.rkt similarity index 89% rename from xenomorph/xenomorph/array.rkt rename to xenomorph/xenomorph/list.rkt index 31313036..64fbb8ee 100644 --- a/xenomorph/xenomorph/array.rkt +++ b/xenomorph/xenomorph/list.rkt @@ -11,7 +11,7 @@ approximates https://github.com/mbutterick/restructure/blob/master/src/Array.coffee |# -(define x:array% +(define x:list% (class x:base% (super-new) (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)) (* 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] #:length [len-kwarg #f] #:count-bytes [count-bytes? #f] #:pre-encode [pre-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)] [len (or len-arg len-kwarg)] [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 (require rackunit "base.rkt") - (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)) + (check-equal? (decode (x:list uint16be 3) #"ABCDEF") '(16706 17220 17734)) + (check-equal? (encode (x:list uint16be 3) '(16706 17220 17734) #f) #"ABCDEF") + (check-equal? (size (x:list uint16be) '(1 2 3)) 6) + (check-equal? (size (x:list doublebe) '(1 2 3 4 5)) 40)) diff --git a/xenomorph/xenomorph/main.rkt b/xenomorph/xenomorph/main.rkt index febaf84f..f6e87350 100644 --- a/xenomorph/xenomorph/main.rkt +++ b/xenomorph/xenomorph/main.rkt @@ -4,17 +4,19 @@ (define-syntax-rule (r+p ID ...) (begin (require ID ...) (provide (all-from-out ID ...)))) -(r+p "array.rkt" - "bitfield.rkt" - "buffer.rkt" +(r+p "bitfield.rkt" + "bytes.rkt" "enum.rkt" "base.rkt" - "lazy-array.rkt" + "list.rkt" "number.rkt" "optional.rkt" "pointer.rkt" "reserved.rkt" "string.rkt" + "stream.rkt" "struct.rkt" + "symbol.rkt" + "vector.rkt" "versioned-struct.rkt" "util.rkt") diff --git a/xenomorph/xenomorph/lazy-array.rkt b/xenomorph/xenomorph/stream.rkt similarity index 84% rename from xenomorph/xenomorph/lazy-array.rkt rename to xenomorph/xenomorph/stream.rkt index a14ec917..b0aa199d 100644 --- a/xenomorph/xenomorph/lazy-array.rkt +++ b/xenomorph/xenomorph/stream.rkt @@ -1,6 +1,6 @@ #lang racket/base (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)) #| @@ -8,8 +8,8 @@ approximates https://github.com/mbutterick/restructure/blob/master/src/LazyArray.coffee |# -(define x:lazy-array% - (class x:array% +(define x:stream% + (class x:list% (super-new) (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]) (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] #:length [len-kwarg #f] #:pre-encode [pre-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 len (or len-arg len-kwarg)) (new (generate-subclass base-class pre-proc post-proc) [type type] [len len] [count-bytes? #false])) +(define x:lazy-array% x:stream%) +(define x:lazy-array x:stream) + (module+ test (require rackunit "number.rkt" "base.rkt") (define bstr #"ABCD1234") (define ds (open-input-bytes bstr)) - (define la (x:lazy-array uint8 4)) + (define la (x:stream 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 (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? (stream->list (decode la2 (open-input-bytes #"\0\1\0\2\0\3\0\4"))) '(1 2 3 4))) \ No newline at end of file diff --git a/xenomorph/xenomorph/string.rkt b/xenomorph/xenomorph/string.rkt index c3fddba1..baddf6e7 100644 --- a/xenomorph/xenomorph/string.rkt +++ b/xenomorph/xenomorph/string.rkt @@ -89,39 +89,3 @@ https://github.com/mbutterick/restructure/blob/master/src/String.coffee (define len (or len-arg len-kwarg)) (define encoding (or enc-arg enc-kwarg 'ascii)) (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)))) \ No newline at end of file diff --git a/xenomorph/xenomorph/symbol.rkt b/xenomorph/xenomorph/symbol.rkt new file mode 100644 index 00000000..c4fa9feb --- /dev/null +++ b/xenomorph/xenomorph/symbol.rkt @@ -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)))) \ No newline at end of file diff --git a/xenomorph/xenomorph/test/array-test.rkt b/xenomorph/xenomorph/test/array-test.rkt deleted file mode 100644 index aca4f06c..00000000 --- a/xenomorph/xenomorph/test/array-test.rkt +++ /dev/null @@ -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))) \ No newline at end of file diff --git a/xenomorph/xenomorph/test/buffer-test.rkt b/xenomorph/xenomorph/test/bytes-test.rkt similarity index 57% rename from xenomorph/xenomorph/test/buffer-test.rkt rename to xenomorph/xenomorph/test/bytes-test.rkt index 694c0f32..4f99cee7 100644 --- a/xenomorph/xenomorph/test/buffer-test.rkt +++ b/xenomorph/xenomorph/test/bytes-test.rkt @@ -1,7 +1,7 @@ #lang racket/base (require rackunit racket/class - "../buffer.rkt" + "../bytes.rkt" "../number.rkt" "../base.rkt") @@ -11,53 +11,53 @@ https://github.com/mbutterick/restructure/blob/master/test/Buffer.coffee |# (test-case - "buffer: should decode" + "bytes: should decode" (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 #x1f #xb6)))) (test-case - "buffer: should error on invalid length" - (check-exn exn:fail:contract? (λ () (x:buffer #:length #true)))) + "bytes: should error on invalid length" + (check-exn exn:fail:contract? (λ () (x:bytes #:length #true)))) (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))]) - (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)))) (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))]) - (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 1)) (bytes #xb6)))) (test-case - "buffer: hould return size" - (check-equal? (size (x:buffer #:length 2) (bytes #xab #xff)) 2)) + "bytes: hould return size" + (check-equal? (size (x:bytes #:length 2) (bytes #xab #xff)) 2)) (test-case - "buffer: hould use defined length if no value given" - (check-equal? (size (x:buffer #:length 10)) 10)) + "bytes: hould use defined length if no value given" + (check-equal? (size (x:bytes #:length 10)) 10)) (test-case - "buffer: should encode" - (let ([buf (x:buffer 2)]) + "bytes: should encode" + (let ([buf (x:bytes 2)]) (check-equal? (bytes-append (encode buf (bytes #xab #xff) #f) (encode buf (bytes #x1f #xb6) #f)) (bytes #xab #xff #x1f #xb6)))) (test-case - "buffer: should encode with pre-encode" + "bytes: should encode with pre-encode" (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 (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 (x:buffer #:length uint8) (bytes #xab #xff) #f) (bytes 2 #xab #xff))) \ No newline at end of file + "bytes: should encode length before bytes" + (check-equal? (encode (x:bytes #:length uint8) (bytes #xab #xff) #f) (bytes 2 #xab #xff))) \ No newline at end of file diff --git a/xenomorph/xenomorph/test/list-test.rkt b/xenomorph/xenomorph/test/list-test.rkt new file mode 100644 index 00000000..cc9ebb5f --- /dev/null +++ b/xenomorph/xenomorph/test/list-test.rkt @@ -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))) \ No newline at end of file diff --git a/xenomorph/xenomorph/test/main.rkt b/xenomorph/xenomorph/test/main.rkt index 87f862af..86fafe9a 100644 --- a/xenomorph/xenomorph/test/main.rkt +++ b/xenomorph/xenomorph/test/main.rkt @@ -1,14 +1,16 @@ #lang racket/base -(require "array-test.rkt" - "bitfield-test.rkt" - "buffer-test.rkt" +(require "bitfield-test.rkt" + "bytes-test.rkt" "enum-test.rkt" - "lazy-array-test.rkt" + "list-test.rkt" "number-test.rkt" "optional-test.rkt" "pointer-test.rkt" "reserved-test.rkt" + "stream-test.rkt" "string-test.rkt" + "symbol-test.rkt" "struct-test.rkt" + "vector-test.rkt" "versioned-struct-test.rkt") diff --git a/xenomorph/xenomorph/test/lazy-array-test.rkt b/xenomorph/xenomorph/test/stream-test.rkt similarity index 82% rename from xenomorph/xenomorph/test/lazy-array-test.rkt rename to xenomorph/xenomorph/test/stream-test.rkt index f5c8ecb6..86e43bfd 100644 --- a/xenomorph/xenomorph/test/lazy-array-test.rkt +++ b/xenomorph/xenomorph/test/stream-test.rkt @@ -2,10 +2,10 @@ (require rackunit racket/class racket/stream - "../array.rkt" + "../list.rkt" "../base.rkt" "../number.rkt" - "../lazy-array.rkt" + "../stream.rkt" "../base.rkt") #| @@ -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 (x:lazy-array uint8 4)) + (define xla (x:stream uint8 4)) (define arr (decode xla)) (check-equal? (stream-length arr) 4) (check-equal? (pos (current-input-port)) 4) @@ -28,9 +28,9 @@ 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 (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)) - (check-false (x:array? arr)) + (check-false (x:list? arr)) (check-equal? (stream-length arr) 4) (check-equal? (pos (current-input-port)) 4) (check-equal? (stream-ref arr 0) 2) @@ -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 (x:lazy-array uint8 4)) + (define xla (x:stream 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 (x:lazy-array uint8 uint8)) + (define xla (x:stream 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 (x:lazy-array uint8 4)) + (define xla (x:stream 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 (x:lazy-array uint8 4)) + (define xla (x:stream 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 (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)) (check-equal? (encode xla arr #f) (bytes 2 4 6 8)))) diff --git a/xenomorph/xenomorph/test/symbol-test.rkt b/xenomorph/xenomorph/test/symbol-test.rkt new file mode 100644 index 00000000..fcc55823 --- /dev/null +++ b/xenomorph/xenomorph/test/symbol-test.rkt @@ -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")))) \ No newline at end of file diff --git a/xenomorph/xenomorph/test/vector-test.rkt b/xenomorph/xenomorph/test/vector-test.rkt new file mode 100644 index 00000000..7dea2021 --- /dev/null +++ b/xenomorph/xenomorph/test/vector-test.rkt @@ -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))) \ No newline at end of file diff --git a/xenomorph/xenomorph/vector.rkt b/xenomorph/xenomorph/vector.rkt new file mode 100644 index 00000000..9367790e --- /dev/null +++ b/xenomorph/xenomorph/vector.rkt @@ -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)) \ No newline at end of file diff --git a/xenomorph/xenomorph/versioned-struct.rkt b/xenomorph/xenomorph/versioned-struct.rkt index eada5210..94fd61b2 100644 --- a/xenomorph/xenomorph/versioned-struct.rkt +++ b/xenomorph/xenomorph/versioned-struct.rkt @@ -17,7 +17,7 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee (init-field [(@type type)] [(@versions versions)]) (unless (for/or ([proc (list integer? procedure? xenomorphic-type? symbol?)]) - (proc @type)) + (proc @type)) (raise-argument-error 'x:versioned-struct "integer, procedure, symbol, or xenomorphic" @type)) (unless (and (dict? @versions) (andmap (λ (v) (or (dict? v) (x:struct? v))) (dict-values @versions))) (raise-argument-error 'x:versioned-struct "dict of dicts or structish" @versions)) @@ -42,19 +42,15 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee [_ (send @type x:decode port parent)])) (dict-set! res x:version-key which-version) - (cond - [(dict-ref @versions 'header #f) - => (λ (header-val) (parse-fields port res header-val))]) + (match (dict-ref @versions 'header #f) + [#false (void)] + [header-val (parse-fields port res header-val)]) - (define field-object - (cond - [(dict-ref @versions which-version #f) => values] - [else - (raise-argument-error 'x:versioned-struct-decode (format "valid field version: ~v" (dict-keys @versions)) which-version)])) - - (match field-object - [(? x:versioned-struct?) (send field-object x:decode port parent)] - [_ (parse-fields port res field-object)])) + (match (dict-ref @versions which-version #f) + [#false (raise-argument-error 'x:versioned-struct-decode + (format "valid field version: ~v" (dict-keys @versions)) which-version)] + [(? x:versioned-struct? vs) (send vs x:decode port parent)] + [field-object (parse-fields port res field-object)])) (define/override (pre-encode val) val) @@ -70,13 +66,13 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee (unless (or (symbol? @type) (procedure? @type)) (send @type x:encode (dict-ref field-data x:version-key #f) port parent)) (for ([(key type) (in-dict (dict-ref @versions 'header null))]) - (send type x:encode (dict-ref field-data key) port parent)) + (send type x:encode (dict-ref field-data key) port parent)) (define fields (select-field-set field-data)) (unless (andmap (λ (key) (member key (dict-keys field-data))) (dict-keys fields)) (raise-argument-error 'x:versioned-struct-encode (format "hash that contains superset of xversioned-struct keys: ~a" (dict-keys fields)) (dict-keys field-data))) (for ([(key type) (in-dict fields)]) - (send type x:encode (dict-ref field-data key) port parent)) + (send type x:encode (dict-ref field-data key) port parent)) (let loop ([i 0]) (when (< i (length (dict-ref parent x:pointers-key))) (define ptr (list-ref (dict-ref parent x:pointers-key) i)) @@ -98,10 +94,10 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee (define header-size (for/sum ([(key type) (in-dict (dict-ref @versions 'header null))]) - (send type x:size (and val (dict-ref val key)) parent))) + (send type x:size (and val (dict-ref val key)) parent))) (define fields-size (for/sum ([(key type) (in-dict (select-field-set val))]) - (send type x:size (and val (dict-ref val key)) parent))) + (send type x:size (and val (dict-ref val key)) parent))) (define pointer-size (if include-pointers (dict-ref parent x:pointer-size-key) 0)) (+ version-size header-size fields-size pointer-size))))