From 53161dc9647a4dff840f21868e4fddfef101c576 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 11 Dec 2018 12:16:00 -0800 Subject: [PATCH] array tests pass --- xenomorph/xenomorph/redo/array.rkt | 91 ++- xenomorph/xenomorph/redo/base.rkt | 11 +- xenomorph/xenomorph/redo/number.rkt | 18 +- xenomorph/xenomorph/redo/test/array-test.rkt | 91 +++ xenomorph/xenomorph/redo/test/number-test.rkt | 519 +++++++----------- xenomorph/xenomorph/redo/util.rkt | 15 + 6 files changed, 400 insertions(+), 345 deletions(-) create mode 100644 xenomorph/xenomorph/redo/test/array-test.rkt create mode 100644 xenomorph/xenomorph/redo/util.rkt diff --git a/xenomorph/xenomorph/redo/array.rkt b/xenomorph/xenomorph/redo/array.rkt index 7e7cb367..19666ba7 100644 --- a/xenomorph/xenomorph/redo/array.rkt +++ b/xenomorph/xenomorph/redo/array.rkt @@ -1,4 +1,5 @@ -#lang racket/base +#lang debug racket/base +(require racket/dict racket/sequence "base.rkt" "number.rkt" "util.rkt" sugar/unstable/dict) (provide (all-defined-out)) #| @@ -6,10 +7,88 @@ approximates https://github.com/mbutterick/restructure/blob/master/src/Array.coffee |# +(define (xarray-decode xa [port-arg (current-input-port)] #:parent [parent #f]) + (define port (->input-port port-arg)) + (define ctx (if (xint? (xarray-len xa)) + (mhasheq 'parent parent + '_startOffset (pos port) + '_currentOffset 0 + '_length (xarray-len xa)) + parent)) + (define decoded-len (resolve-length (xarray-len xa) port parent)) + (cond + [(or (not decoded-len) (eq? (xarray-length-type xa) 'bytes)) + (define end-pos (cond + ;; decoded-len is byte length + [decoded-len (+ (pos port) decoded-len)] + ;; no decoded-len, but parent has length + [(and parent (not (zero? (dict-ref parent '_length)))) (+ (dict-ref parent '_startOffset) (dict-ref parent '_length))] + ;; no decoded-len or parent, so consume whole stream + [else +inf.0])) + (for/list ([i (in-naturals)] + #:break (or (eof-object? (peek-byte port)) (= (pos port) end-pos))) + (decode (xarray-type xa) port #:parent ctx))] + ;; we have decoded-len, which is treated as count of items + [else (for/list ([i (in-range decoded-len)]) + (decode (xarray-type xa) port #:parent ctx))])) +(define (xarray-encode xa array [port-arg #f] #:parent [parent #f]) + (unless (sequence? array) + (raise-argument-error 'xarray-encode "sequence" array)) + (define port (if (output-port? port-arg) port-arg (open-output-bytes))) + (define (encode-items ctx) + ;; todo: should array with fixed length stop encoding after it reaches max? + (let* (#;[items (sequence->list array)] + #;[item-count (length items)] + #;[max-items (if (number? (xarray-len xa)) (xarray-len xa) item-count)]) + (for ([item array]) + (encode (xarray-type xa) item port #:parent ctx)))) -(test-module - (check-equal? (decode (+Array uint16be 3) #"ABCDEF") '(16706 17220 17734)) - (check-equal? (encode (+Array uint16be 3) '(16706 17220 17734) #f) #"ABCDEF") - (check-equal? (size (+Array uint16be) '(1 2 3)) 6) - (check-equal? (size (+Array doublebe) '(1 2 3 4 5)) 40)) + (cond + [(xint? (xarray-len xa)) + (define ctx (mhash 'pointers null + 'startOffset (pos port) + 'parent parent)) + (dict-set! ctx 'pointerOffset (+ (pos port) (size xa array ctx))) + (encode (xarray-len xa) (length array) port) ; encode length at front + (encode-items ctx) + (for ([ptr (in-list (dict-ref ctx 'pointers))]) ; encode pointer data at end + (encode (dict-ref ptr 'type) (dict-ref ptr 'val) port))] + [else (encode-items parent)]) + (unless port-arg (get-output-bytes port))) + +(define (xarray-size xa [val #f] [ctx #f]) + (when val (unless (sequence? val) + (raise-argument-error 'xarray-size "sequence" val))) + (cond + [val (let-values ([(ctx len-size) (if (xint? (xarray-len xa)) + (values (mhasheq 'parent ctx) (size (xarray-len xa))) + (values ctx 0))]) + (+ len-size (for/sum ([item val]) + (size (xarray-type xa) item ctx))))] + [else (let ([item-count (resolve-length (xarray-len xa) #f ctx)] + [item-size (size (xarray-type xa) #f ctx)]) + (* item-size item-count))])) + +(struct xarray (type len length-type) #:transparent + #:methods gen:xenomorphic + [(define decode xarray-decode) + (define encode xarray-encode) + (define size xarray-size)]) + +(define (+xarray type [len #f] [length-type 'count]) + (unless (xenomorphic? type) + (raise-argument-error '+xarray "xenomorphic type" type)) + (unless (length-resolvable? len) + (raise-argument-error '+xarray "length-resolvable?" len)) + (unless (memq length-type '(bytes count)) + (raise-argument-error '+xarray "'bytes or 'count" length-type)) + (xarray type len length-type)) + + +(module+ test + (require rackunit) + (check-equal? (decode (+xarray uint16be 3) #"ABCDEF") '(16706 17220 17734)) + (check-equal? (encode (+xarray uint16be 3) '(16706 17220 17734)) #"ABCDEF") + (check-equal? (size (+xarray uint16be) '(1 2 3)) 6) + (check-equal? (size (+xarray doublebe) '(1 2 3 4 5)) 40)) diff --git a/xenomorph/xenomorph/redo/base.rkt b/xenomorph/xenomorph/redo/base.rkt index a25ae748..2e57f67a 100644 --- a/xenomorph/xenomorph/redo/base.rkt +++ b/xenomorph/xenomorph/redo/base.rkt @@ -31,7 +31,12 @@ [(list? x) (map loop x)] [else x]))) +(define (pos p [new-pos #f]) + (when new-pos + (file-position p new-pos)) + (file-position p)) + (define-generics xenomorphic - (encode xenomorphic val [port]) - (decode xenomorphic [port]) - (size xenomorphic)) \ No newline at end of file + (encode xenomorphic val [port] #:parent [parent]) + (decode xenomorphic [port] #:parent [parent]) + (size xenomorphic [item] [parent])) \ No newline at end of file diff --git a/xenomorph/xenomorph/redo/number.rkt b/xenomorph/xenomorph/redo/number.rkt index 4855d422..de8766d8 100644 --- a/xenomorph/xenomorph/redo/number.rkt +++ b/xenomorph/xenomorph/redo/number.rkt @@ -12,7 +12,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee (define system-endian (if (system-big-endian?) 'be 'le)) -(define (xint-encode i val [port #f]) +(define (xint-encode i val [port #f] #:parent [parent #f]) (unless (xint? i) (raise-argument-error 'encode "xint instance" i)) (define-values (bound-min bound-max) (bounds i)) @@ -28,7 +28,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee (define res (apply bytes ((if (eq? (xint-endian i) 'be) values reverse) bs))) (if port (write-bytes res port) res)) -(define (xint-decode i [port-arg (current-input-port)]) +(define (xint-decode i [port-arg (current-input-port)] #:parent [parent #f]) (unless (xint? i) (raise-argument-error 'decode "xint instance" i)) (define bstr (read-bytes (xint-size i) (->input-port port-arg))) @@ -46,7 +46,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee #:methods gen:xenomorphic [(define decode xint-decode) (define encode xint-encode) - (define size (λ (i) (xint-size i)))]) + (define size (λ (i [item #f] [parent #f]) (xint-size i)))]) (define (+xint [size 2] #:signed [signed #true] #:endian [endian system-endian]) (unless (exact-positive-integer? size) @@ -142,13 +142,13 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee (check-equal? (encode int8 -1) (bytes 255)) (check-equal? (encode int8 127) (bytes 127))) -(define (xfloat-decode xf [port-arg (current-input-port)]) +(define (xfloat-decode xf [port-arg (current-input-port)] #:parent [parent #f]) (unless (xfloat? xf) (raise-argument-error 'decode "xfloat instance" xf)) (define bs (read-bytes (xfloat-size xf) (->input-port port-arg))) (floating-point-bytes->real bs (eq? (xfloat-endian xf) 'be))) -(define (xfloat-encode xf val [port #f]) +(define (xfloat-encode xf val [port #f] #:parent [parent #f]) (unless (xfloat? xf) (raise-argument-error 'encode "xfloat instance" xf)) (unless (or (not port) (output-port? port)) @@ -160,7 +160,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee #:methods gen:xenomorphic [(define decode xfloat-decode) (define encode xfloat-encode) - (define size (λ (i) (xfloat-size i)))]) + (define size (λ (i [item #f] [parent #f]) (xfloat-size i)))]) (define (+xfloat [size 4] #:endian [endian system-endian]) (unless (exact-positive-integer? size) @@ -177,13 +177,13 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee (define doublebe (+xfloat 8 #:endian 'be)) (define doublele (+xfloat 8 #:endian 'le)) -(define (xfixed-decode xf [port-arg (current-input-port)]) +(define (xfixed-decode xf [port-arg (current-input-port)] #:parent [parent #f]) (unless (xfixed? xf) (raise-argument-error 'decode "xfixed instance" xf)) (define int (xint-decode xf port-arg)) (exact-if-possible (/ int (fixed-shift xf) 1.0))) -(define (xfixed-encode xf val [port #f]) +(define (xfixed-encode xf val [port #f] #:parent [parent #f]) (unless (xfixed? xf) (raise-argument-error 'encode "xfixed instance" xf)) (define int (exact-if-possible (floor (* val (fixed-shift xf))))) @@ -193,7 +193,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee #:methods gen:xenomorphic [(define decode xfixed-decode) (define encode xfixed-encode) - (define size (λ (i) (xint-size i)))]) + (define size (λ (i [item #f] [parent #f]) (xint-size i)))]) (define (+xfixed [size 2] #:signed [signed #true] #:endian [endian system-endian] [fracbits (/ (* size 8) 2)]) (unless (exact-positive-integer? size) diff --git a/xenomorph/xenomorph/redo/test/array-test.rkt b/xenomorph/xenomorph/redo/test/array-test.rkt new file mode 100644 index 00000000..1e153648 --- /dev/null +++ b/xenomorph/xenomorph/redo/test/array-test.rkt @@ -0,0 +1,91 @@ +#lang racket/base +(require rackunit + "../base.rkt" + "../array.rkt" + "../number.rkt" + sugar/unstable/dict) + +#| +approximates +https://github.com/mbutterick/restructure/blob/master/test/Array.coffee +|# + +(test-case + "decode fixed length" + (parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))]) + (check-equal? (decode (+xarray uint8 4)) '(1 2 3 4)))) + +(test-case + "decode fixed number of bytes" + (parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))]) + (check-equal? (decode (+xarray uint16be 4 'bytes)) '(258 772)))) + +(test-case + "decode length from parent key" + (parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))]) + (check-equal? (decode (+xarray uint8 'len) #:parent (mhash 'len 4)) '(1 2 3 4)))) + +(test-case + "decode byte count from parent key" + (parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))]) + (check-equal? (decode (+xarray uint16be 'len 'bytes) #:parent (mhash 'len 4)) '(258 772)))) + +(test-case + "decode length as number before array" + (parameterize ([current-input-port (open-input-bytes (bytes 4 1 2 3 4 5))]) + (check-equal? (decode (+xarray uint8 uint8)) '(1 2 3 4)))) + +(test-case + "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 uint16be uint8 'bytes)) '(258 772)))) + +(test-case + "decode length from function" + (parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))]) + (check-equal? (decode (+xarray uint8 (λ _ 4))) '(1 2 3 4)))) + +(test-case + "decode byte count from function" + (parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))]) + (check-equal? (decode (+xarray uint16be (λ _ 4) 'bytes)) '(258 772)))) + +(test-case + "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 uint8) #:parent (mhash '_length 4 '_startOffset 0)) '(1 2 3 4)))) + +(test-case + "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 uint8) #:parent (mhash '_length 0 '_startOffset 0)) '(1 2 3 4 5)))) + +(test-case + "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 uint8)) '(1 2 3 4 )))) + +(test-case + "use array length" + (check-equal? (size (+xarray uint8 10) '(1 2 3 4)) 4)) + +(test-case + "add size of length field before string" + (check-equal? (size (+xarray uint8 uint8) '(1 2 3 4)) 5)) + +(test-case + "use defined length if no value given" + (check-equal? (size (+xarray uint8 10)) 10)) + +(test-case + "encode using array length" + (check-equal? (encode (+xarray uint8 10) '(1 2 3 4)) (bytes 1 2 3 4))) + +(test-case + "encode length as number before array" + (check-equal? (encode (+xarray uint8 uint8) '(1 2 3 4)) (bytes 4 1 2 3 4))) + +;; todo: reinstate pointer test +#;(test-case + "add pointers after array if length is encoded at start" + (check-equal? (encode (+xarray (+Pointer uint8 uint8) uint8) '(1 2 3 4)) (bytes 4 5 6 7 8 1 2 3 4))) \ No newline at end of file diff --git a/xenomorph/xenomorph/redo/test/number-test.rkt b/xenomorph/xenomorph/redo/test/number-test.rkt index 9a337cd2..8040fbab 100644 --- a/xenomorph/xenomorph/redo/test/number-test.rkt +++ b/xenomorph/xenomorph/redo/test/number-test.rkt @@ -1,330 +1,195 @@ #lang racket/base (require rackunit "../number.rkt" "../base.rkt") -;describe 'Number', -> -; describe 'uint8', -> -; it 'should decode', -> -; it 'should have a size', -> -; it 'should encode', (done) -> -(parameterize ([current-input-port (open-input-bytes (bytes #xab #xff))]) - (check-equal? (decode uint8) #xab) - (check-equal? (decode uint8) #xff)) - -(check-equal? (size uint8) 1) - -(let ([port (open-output-bytes)]) - (encode uint8 #xab port) - (encode uint8 #xff port) - (check-equal? (dump port) (bytes #xab #xff))) - - -; describe 'uint16', -> -; it 'is an alias for uint16be', -> -; modified test: `uint16` is the same endianness as the platform -(check-equal? (decode uint16 (bytes 0 1)) (decode (if (system-big-endian?) - uint16be - uint16le) (bytes 0 1))) - -; describe 'uint16be', -> -; it 'should decode', -> -; it 'should have a size', -> -; it 'should encode', (done) -> - -(check-equal? (decode uint16be (open-input-bytes (bytes #xab #xff))) #xabff) -(check-equal? (size uint16be) 2) -(check-equal? (encode uint16be #xabff #f) (bytes #xab #xff)) - -; -; describe 'uint16le', -> -; it 'should decode', -> -; it 'should have a size', -> -; it 'should encode', (done) -> - -(check-equal? (decode uint16le (open-input-bytes (bytes #xff #xab))) #xabff) -(check-equal? (size uint16le) 2) -(check-equal? (encode uint16le #xabff #f) (bytes #xff #xab)) - -; -; describe 'uint24', -> -; it 'is an alias for uint24be', -> -;; modified test: `uint24` is the same endianness as the platform -(check-equal? (decode uint24 (bytes 0 1 2)) (decode (if (system-big-endian?) - uint24be - uint24le) (bytes 0 1 2))) - -; -; describe 'uint24be', -> -; it 'should decode', -> -; it 'should have a size', -> -; it 'should encode', (done) -> - -(check-equal? (decode uint24be (open-input-bytes (bytes #xff #xab #x24))) #xffab24) -(check-equal? (size uint24be) 3) -(check-equal? (encode uint24be #xffab24 #f) (bytes #xff #xab #x24)) - -; -; describe 'uint24le', -> -; it 'should decode', -> -; it 'should have a size', -> -; it 'should encode', (done) -> - -(check-equal? (decode uint24le (open-input-bytes (bytes #x24 #xab #xff))) #xffab24) -(check-equal? (size uint24le) 3) -(check-equal? (encode uint24le #xffab24 #f) (bytes #x24 #xab #xff)) - -; -; describe 'uint32', -> -; it 'is an alias for uint32be', -> -;; modified test: `uint32` is the same endianness as the platform -(check-equal? (decode uint32 (bytes 0 1 2 3)) (decode (if (system-big-endian?) - uint32be - uint32le) (bytes 0 1 2 3))) - -; -; describe 'uint32be', -> -; it 'should decode', -> -; it 'should have a size', -> -; it 'should encode', (done) -> - -(check-equal? (decode uint32be (open-input-bytes (bytes #xff #xab #x24 #xbf))) #xffab24bf) -(check-equal? (size uint32be) 4) -(check-equal? (encode uint32be #xffab24bf #f) (bytes #xff #xab #x24 #xbf)) - -; -; describe 'uint32le', -> -; it 'should decode', -> -; it 'should encode', (done) -> - -(check-equal? (decode uint32le (open-input-bytes (bytes #xbf #x24 #xab #xff))) #xffab24bf) -(check-equal? (size uint32le) 4) -(check-equal? (encode uint32le #xffab24bf #f) (bytes #xbf #x24 #xab #xff)) - - -; -; describe 'int8', -> -; it 'should decode', -> -; it 'should have a size', -> -; it 'should encode', (done) -> - -(let ([port (open-input-bytes (bytes #x7f #xff))]) - (check-equal? (decode int8 port) 127) - (check-equal? (decode int8 port) -1)) - -(check-equal? (size int8) 1) - -(let ([port (open-output-bytes)]) - (encode int8 127 port) - (encode int8 -1 port) - (check-equal? (dump port) (bytes #x7f #xff))) - - -; -; describe 'int16', -> -; it 'is an alias for int16be', -> -; int16.should.equal int16be - -;; modified test: `int16` is the same endianness as the platform -(check-equal? (decode int16 (bytes 0 1)) (decode (if (system-big-endian?) - int16be - int16le) (bytes 0 1))) - - -; -; describe 'int16be', -> -; it 'should decode', -> -; it 'should have a size', -> -; it 'should encode', (done) -> - -(let ([port (open-input-bytes (bytes #xff #xab))]) - (check-equal? (decode int16be port) -85)) - -(check-equal? (size int16be) 2) - -(let ([port (open-output-bytes)]) - (encode int16be -85 port) - (check-equal? (dump port) (bytes #xff #xab))) - - -; describe 'int16le', -> -; it 'should decode', -> -; it 'should have a size', -> -; it 'should encode', (done) -> - -(check-equal? (decode int16le (open-input-bytes (bytes #xab #xff))) -85) -(check-equal? (size int16le) 2) -(check-equal? (encode int16le -85 #f) (bytes #xab #xff)) - - -; -; describe 'int24', -> -; it 'is an alias for int24be', -> -; int24.should.equal int24be - -;; modified test: `int24` is the same endianness as the platform -(check-equal? (decode int24 (bytes 0 1 2)) (decode (if (system-big-endian?) - int24be - int24le) (bytes 0 1 2))) - - -; -; describe 'int24be', -> -; it 'should decode', -> -; it 'should have a size', -> -; it 'should encode', (done) -> - -(check-equal? (decode int24be (open-input-bytes (bytes #xff #xab #x24))) -21724) -(check-equal? (size int24be) 3) -(check-equal? (encode int24be -21724 #f) (bytes #xff #xab #x24)) - -; -; describe 'int24le', -> -; it 'should decode', -> -; it 'should have a size', -> -; it 'should encode', (done) -> - -(check-equal? (decode int24le (open-input-bytes (bytes #x24 #xab #xff))) -21724) -(check-equal? (size int24le) 3) -(check-equal? (encode int24le -21724 #f) (bytes #x24 #xab #xff)) - - - -; describe 'int32', -> -; it 'is an alias for int32be', -> -; modified test: `int32` is the same endianness as the platform -(check-equal? (decode int32 (bytes 0 1 2 3)) (decode (if (system-big-endian?) - int32be - int32le) (bytes 0 1 2 3))) - - - -; -; describe 'int32be', -> -; it 'should decode', -> -; it 'should have a size', -> -; it 'should encode', (done) -> - -(check-equal? (decode int32be (open-input-bytes (bytes #xff #xab #x24 #xbf))) -5561153) -(check-equal? (size int32be) 4) -(check-equal? (encode int32be -5561153 #f) (bytes #xff #xab #x24 #xbf)) - -; -; describe 'int32le', -> -; it 'should decode', -> -; it 'should have a size', -> -; it 'should encode', (done) -> - -(check-equal? (decode int32le (open-input-bytes (bytes #xbf #x24 #xab #xff))) -5561153) -(check-equal? (size int32le) 4) -(check-equal? (encode int32le -5561153 #f) (bytes #xbf #x24 #xab #xff)) - -; -; describe 'float', -> -; it 'is an alias for floatbe', -> -; modified test: `float` is the same endianness as the platform -(check-equal? (decode float (bytes 0 1 2 3)) (decode (if (system-big-endian?) - floatbe - floatle) (bytes 0 1 2 3))) - -; -; describe 'floatbe', -> -; it 'should decode', -> -; it 'should have a size', -> -; it 'should encode', (done) -> - -(check-= (decode floatbe (open-input-bytes (bytes #x43 #x7a #x8c #xcd))) 250.55 0.01) -(check-equal? (size floatbe) 4) -(check-equal? (encode floatbe 250.55 #f) (bytes #x43 #x7a #x8c #xcd)) - -; -; describe 'floatle', -> -; it 'should decode', -> -; it 'should have a size', -> -; it 'should encode', (done) -> - -(check-= (decode floatle (open-input-bytes (bytes #xcd #x8c #x7a #x43))) 250.55 0.01) -(check-equal? (size floatle) 4) -(check-equal? (encode floatle 250.55 #f) (bytes #xcd #x8c #x7a #x43)) - -; -; describe 'double', -> -; it 'is an alias for doublebe', -> -; modified test: `double` is the same endianness as the platform -(check-equal? (decode double (bytes 0 1 2 3 4 5 6 7)) (decode (if (system-big-endian?) - doublebe - doublele) (bytes 0 1 2 3 4 5 6 7))) - -; -; describe 'doublebe', -> -; it 'should decode', -> -; it 'should have a size', -> -; it 'should encode', (done) -> - -(check-equal? (decode doublebe (open-input-bytes (bytes #x40 #x93 #x4a #x3d #x70 #xa3 #xd7 #x0a))) 1234.56) -(check-equal? (size doublebe) 8) -(check-equal? (encode doublebe 1234.56 #f) (bytes #x40 #x93 #x4a #x3d #x70 #xa3 #xd7 #x0a)) - -; -; describe 'doublele', -> -; it 'should decode', -> -; it 'should have a size', -> -; it 'should encode', (done) -> - -(check-equal? (decode doublele (open-input-bytes (bytes #x0a #xd7 #xa3 #x70 #x3d #x4a #x93 #x40))) 1234.56) -(check-equal? (size doublele) 8) -(check-equal? (encode doublele 1234.56 #f) (bytes #x0a #xd7 #xa3 #x70 #x3d #x4a #x93 #x40)) - -; -; describe 'fixed16', -> -; it 'is an alias for fixed16be', -> -; modified test: `fixed16` is the same endianness as the platform -(check-equal? (decode fixed16 (bytes 0 1)) (decode (if (system-big-endian?) - fixed16be - fixed16le) (bytes 0 1))) - -; -; describe 'fixed16be', -> -; it 'should decode', -> -; it 'should have a size', -> -; it 'should encode', (done) -> - -(check-= (decode fixed16be (open-input-bytes (bytes #x19 #x57))) 25.34 0.01) -(check-equal? (size fixed16be) 2) -(check-equal? (encode fixed16be 25.34 #f) (bytes #x19 #x57)) - -; -; describe 'fixed16le', -> -; it 'should decode', -> -; it 'should have a size', -> -; it 'should encode', (done) -> - -(check-= (decode fixed16le (open-input-bytes (bytes #x57 #x19))) 25.34 0.01) -(check-equal? (size fixed16le) 2) -(check-equal? (encode fixed16le 25.34 #f) (bytes #x57 #x19)) - -; -; describe 'fixed32', -> -; it 'is an alias for fixed32be', -> -; modified test: `fixed32` is the same endianness as the platform - -(check-equal? (decode fixed32 (bytes 0 1 2 3)) (decode (if (system-big-endian?) - fixed32be - fixed32le) (bytes 0 1 2 3))) - -; -; describe 'fixed32be', -> -; it 'should decode', -> -; it 'should have a size', -> -; it 'should encode', (done) -> -(check-= (decode fixed32be (open-input-bytes (bytes #x00 #xfa #x8c #xcc))) 250.55 0.01) -(check-equal? (size fixed32be) 4) -(check-equal? (encode fixed32be 250.55 #f) (bytes #x00 #xfa #x8c #xcc)) - -; -; describe 'fixed32le', -> -; it 'should decode', -> -; it 'should have a size', -> -; it 'should encode', (done) -> - -(check-= (decode fixed32le (open-input-bytes (bytes #xcc #x8c #xfa #x00))) 250.55 0.01) -(check-equal? (size fixed32le) 4) -(check-equal? (encode fixed32le 250.55 #f) (bytes #xcc #x8c #xfa #x00)) \ No newline at end of file +#| +approximates +https://github.com/mbutterick/restructure/blob/master/test/Number.coffee +|# + +(test-case + "uint8: decode, size, encode" + (parameterize ([current-input-port (open-input-bytes (bytes #xab #xff))]) + (check-equal? (decode uint8) #xab) + (check-equal? (decode uint8) #xff)) + (check-equal? (size uint8) 1) + (let ([port (open-output-bytes)]) + (encode uint8 #xab port) + (encode uint8 #xff port) + (check-equal? (dump port) (bytes #xab #xff)))) + +(test-case + "uint16 is the same endianness as the platform" + (check-equal? (decode uint16 (bytes 0 1)) + (decode (if (system-big-endian?) uint16be uint16le) (bytes 0 1)))) + +(test-case + "uint16be: decode, size, encode" + (check-equal? (decode uint16be (open-input-bytes (bytes #xab #xff))) #xabff) + (check-equal? (size uint16be) 2) + (check-equal? (encode uint16be #xabff #f) (bytes #xab #xff))) + +(test-case + "uint16le: decode, size, encode" + (check-equal? (decode uint16le (open-input-bytes (bytes #xff #xab))) #xabff) + (check-equal? (size uint16le) 2) + (check-equal? (encode uint16le #xabff #f) (bytes #xff #xab))) + +(test-case + "uint24 is the same endianness as the platform" + (check-equal? (decode uint24 (bytes 0 1 2)) + (decode (if (system-big-endian?) uint24be uint24le) (bytes 0 1 2)))) +(test-case + "uint24be: decode, size, encode" + (check-equal? (decode uint24be (open-input-bytes (bytes #xff #xab #x24))) #xffab24) + (check-equal? (size uint24be) 3) + (check-equal? (encode uint24be #xffab24 #f) (bytes #xff #xab #x24))) + +(test-case + "uint24le: decode, size, encode" + (check-equal? (decode uint24le (open-input-bytes (bytes #x24 #xab #xff))) #xffab24) + (check-equal? (size uint24le) 3) + (check-equal? (encode uint24le #xffab24 #f) (bytes #x24 #xab #xff))) + +(test-case + "uint32 is the same endianness as the platform" + (check-equal? (decode uint32 (bytes 0 1 2 3)) + (decode (if (system-big-endian?) uint32be uint32le) (bytes 0 1 2 3)))) +(test-case + "uint32be: decode, size, encode" + (check-equal? (decode uint32be (open-input-bytes (bytes #xff #xab #x24 #xbf))) #xffab24bf) + (check-equal? (size uint32be) 4) + (check-equal? (encode uint32be #xffab24bf #f) (bytes #xff #xab #x24 #xbf))) + +(test-case + "uint32le: decode, size, encode" + (check-equal? (decode uint32le (open-input-bytes (bytes #xbf #x24 #xab #xff))) #xffab24bf) + (check-equal? (size uint32le) 4) + (check-equal? (encode uint32le #xffab24bf #f) (bytes #xbf #x24 #xab #xff))) + +(test-case + "int8: decode, size, encode" + (let ([port (open-input-bytes (bytes #x7f #xff))]) + (check-equal? (decode int8 port) 127) + (check-equal? (decode int8 port) -1)) + (check-equal? (size int8) 1) + (let ([port (open-output-bytes)]) + (encode int8 127 port) + (encode int8 -1 port) + (check-equal? (dump port) (bytes #x7f #xff)))) + +(test-case + "int32 is the same endianness as the platform" + (check-equal? (decode int16 (bytes 0 1)) + (decode (if (system-big-endian?) int16be int16le) (bytes 0 1)))) +(test-case + "int16be: decode, size, encode" + (let ([port (open-input-bytes (bytes #xff #xab))]) + (check-equal? (decode int16be port) -85)) + (check-equal? (size int16be) 2) + (let ([port (open-output-bytes)]) + (encode int16be -85 port) + (check-equal? (dump port) (bytes #xff #xab)))) + +(test-case + "int16le: decode, size, encode" + (check-equal? (decode int16le (open-input-bytes (bytes #xab #xff))) -85) + (check-equal? (size int16le) 2) + (check-equal? (encode int16le -85 #f) (bytes #xab #xff))) + +(test-case + "int24 is the same endianness as the platform" + (check-equal? (decode int24 (bytes 0 1 2)) + (decode (if (system-big-endian?) int24be int24le) (bytes 0 1 2)))) +(test-case + "int24be: decode, size, encode" + (check-equal? (decode int24be (open-input-bytes (bytes #xff #xab #x24))) -21724) + (check-equal? (size int24be) 3) + (check-equal? (encode int24be -21724 #f) (bytes #xff #xab #x24))) + +(test-case + "int24le: decode, size, encode" + (check-equal? (decode int24le (open-input-bytes (bytes #x24 #xab #xff))) -21724) + (check-equal? (size int24le) 3) + (check-equal? (encode int24le -21724 #f) (bytes #x24 #xab #xff))) +(test-case + "int32 is the same endianness as the platform" + (check-equal? (decode int32 (bytes 0 1 2 3)) + (decode (if (system-big-endian?) int32be int32le) (bytes 0 1 2 3)))) + +(test-case + "int32be: decode, size, encode" + (check-equal? (decode int32be (open-input-bytes (bytes #xff #xab #x24 #xbf))) -5561153) + (check-equal? (size int32be) 4) + (check-equal? (encode int32be -5561153 #f) (bytes #xff #xab #x24 #xbf))) + +(test-case + "int32le: decode, size, encode" + (check-equal? (decode int32le (open-input-bytes (bytes #xbf #x24 #xab #xff))) -5561153) + (check-equal? (size int32le) 4) + (check-equal? (encode int32le -5561153 #f) (bytes #xbf #x24 #xab #xff))) + +(test-case + "float is the same endianness as the platform" + (check-equal? (decode float (bytes 0 1 2 3)) + (decode (if (system-big-endian?) floatbe floatle) (bytes 0 1 2 3)))) +(test-case + "floatbe: decode, size, encode" + (check-= (decode floatbe (open-input-bytes (bytes #x43 #x7a #x8c #xcd))) 250.55 0.01) + (check-equal? (size floatbe) 4) + (check-equal? (encode floatbe 250.55 #f) (bytes #x43 #x7a #x8c #xcd))) + +(test-case + "floatle: decode, size, encode" + (check-= (decode floatle (open-input-bytes (bytes #xcd #x8c #x7a #x43))) 250.55 0.01) + (check-equal? (size floatle) 4) + (check-equal? (encode floatle 250.55 #f) (bytes #xcd #x8c #x7a #x43))) + +(test-case + "double is the same endianness as the platform" + (check-equal? (decode double (bytes 0 1 2 3 4 5 6 7)) + (decode (if (system-big-endian?) doublebe doublele) (bytes 0 1 2 3 4 5 6 7)))) +(test-case + "doublebe: decode, size, encode" + (check-equal? (decode doublebe (open-input-bytes (bytes #x40 #x93 #x4a #x3d #x70 #xa3 #xd7 #x0a))) 1234.56) + (check-equal? (size doublebe) 8) + (check-equal? (encode doublebe 1234.56 #f) (bytes #x40 #x93 #x4a #x3d #x70 #xa3 #xd7 #x0a))) + +(test-case + "doublele: decode, size, encode" + (check-equal? (decode doublele (open-input-bytes (bytes #x0a #xd7 #xa3 #x70 #x3d #x4a #x93 #x40))) 1234.56) + (check-equal? (size doublele) 8) + (check-equal? (encode doublele 1234.56 #f) (bytes #x0a #xd7 #xa3 #x70 #x3d #x4a #x93 #x40))) + +(test-case + "fixed16 is the same endianness as the platform" + (check-equal? (decode fixed16 (bytes 0 1)) + (decode (if (system-big-endian?) fixed16be fixed16le) (bytes 0 1)))) + +(test-case + "fixed16be: decode, size, encode" + (check-= (decode fixed16be (open-input-bytes (bytes #x19 #x57))) 25.34 0.01) + (check-equal? (size fixed16be) 2) + (check-equal? (encode fixed16be 25.34 #f) (bytes #x19 #x57))) + +(test-case + "fixed16le: decode, size, encode" + (check-= (decode fixed16le (open-input-bytes (bytes #x57 #x19))) 25.34 0.01) + (check-equal? (size fixed16le) 2) + (check-equal? (encode fixed16le 25.34 #f) (bytes #x57 #x19))) + +(test-case + "fixed32 is the same endianness as the platform" + (check-equal? (decode fixed32 (bytes 0 1 2 3)) + (decode (if (system-big-endian?) fixed32be fixed32le) (bytes 0 1 2 3)))) + +(test-case + "fixed32be: decode, size, encode" + (check-= (decode fixed32be (open-input-bytes (bytes #x00 #xfa #x8c #xcc))) 250.55 0.01) + (check-equal? (size fixed32be) 4) + (check-equal? (encode fixed32be 250.55 #f) (bytes #x00 #xfa #x8c #xcc))) + +(test-case + "fixed32le: decode, size, encode" + (check-= (decode fixed32le (open-input-bytes (bytes #xcc #x8c #xfa #x00))) 250.55 0.01) + (check-equal? (size fixed32le) 4) + (check-equal? (encode fixed32le 250.55 #f) (bytes #xcc #x8c #xfa #x00))) \ No newline at end of file diff --git a/xenomorph/xenomorph/redo/util.rkt b/xenomorph/xenomorph/redo/util.rkt new file mode 100644 index 00000000..89f8092a --- /dev/null +++ b/xenomorph/xenomorph/redo/util.rkt @@ -0,0 +1,15 @@ +#lang racket/base +(require racket/dict "number.rkt" "base.rkt") +(provide (all-defined-out)) + +(define (length-resolvable? x) + (or (not x) (symbol? x) (xenomorphic? x) (procedure? x) (exact-nonnegative-integer? x))) + +(define (resolve-length x [port #f] [parent #f]) + (cond + [(not x) #f] + [(exact-nonnegative-integer? x) x] + [(procedure? x) (x parent)] + [(and parent (symbol? x)) (dict-ref parent x)] + [(and port (xint? x)) (decode x port)] + [else (raise-argument-error 'resolve-length "fixed-size argument" x)])) \ No newline at end of file