array tests pass

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))

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))
+  (encode xenomorphic val [port] #:parent [parent])
+  (decode xenomorphic [port] #:parent [parent])
+  (size xenomorphic [item] [parent]))

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)

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)))

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))
+#|
+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)))

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)]))