From 0eba993f8d0eca1d95feaa0e6cd2e7e999e41e53 Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Tue, 11 Dec 2018 10:31:18 -0800
Subject: [PATCH] number tests pass

---
 xenomorph/xenomorph/redo/array.rkt            |  15 +
 xenomorph/xenomorph/redo/base.rkt             |  16 +-
 xenomorph/xenomorph/redo/number.rkt           |   6 +
 xenomorph/xenomorph/redo/test/number-test.rkt | 330 ++++++++++++++++++
 4 files changed, 366 insertions(+), 1 deletion(-)
 create mode 100644 xenomorph/xenomorph/redo/array.rkt
 create mode 100644 xenomorph/xenomorph/redo/test/number-test.rkt

diff --git a/xenomorph/xenomorph/redo/array.rkt b/xenomorph/xenomorph/redo/array.rkt
new file mode 100644
index 00000000..7e7cb367
--- /dev/null
+++ b/xenomorph/xenomorph/redo/array.rkt
@@ -0,0 +1,15 @@
+#lang racket/base
+(provide (all-defined-out))
+
+#|
+approximates
+https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
+|#
+
+
+
+(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))
diff --git a/xenomorph/xenomorph/redo/base.rkt b/xenomorph/xenomorph/redo/base.rkt
index 21984f1b..a25ae748 100644
--- a/xenomorph/xenomorph/redo/base.rkt
+++ b/xenomorph/xenomorph/redo/base.rkt
@@ -1,5 +1,7 @@
 #lang racket/base
-(require racket/generic)
+(require racket/generic
+         racket/dict
+         racket/port)
 (provide (all-defined-out))
 
 (define (->input-port arg)
@@ -17,6 +19,18 @@
 (define (signed->unsigned sint bits)
   (bitwise-and sint (arithmetic-shift 1 bits)))
 
+(define (dump x)
+  (define (dump-dict x)
+    (for/list ([(k v) (in-dict x)])
+      (cons (dump k) (dump v))))
+  (let loop ([x x])
+    (cond
+      [(input-port? x) (port->bytes x)]
+      [(output-port? x) (get-output-bytes x)]
+      [(dict? x) (dump-dict x)]
+      [(list? x) (map loop x)]
+      [else x])))
+
 (define-generics xenomorphic
   (encode xenomorphic val [port])
   (decode xenomorphic [port])
diff --git a/xenomorph/xenomorph/redo/number.rkt b/xenomorph/xenomorph/redo/number.rkt
index 88d2f706..4855d422 100644
--- a/xenomorph/xenomorph/redo/number.rkt
+++ b/xenomorph/xenomorph/redo/number.rkt
@@ -2,6 +2,12 @@
 (require "base.rkt")
 (provide (all-defined-out))
 
+#|
+approximates
+https://github.com/mbutterick/restructure/blob/master/src/Number.coffee
+|#
+
+
 (define (exact-if-possible x) (if (integer? x) (inexact->exact x) x))
 
 (define system-endian (if (system-big-endian?) 'be 'le))
diff --git a/xenomorph/xenomorph/redo/test/number-test.rkt b/xenomorph/xenomorph/redo/test/number-test.rkt
new file mode 100644
index 00000000..9a337cd2
--- /dev/null
+++ b/xenomorph/xenomorph/redo/test/number-test.rkt
@@ -0,0 +1,330 @@
+#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