buffer done

xenomorph/xenomorph/redo/buffer.rkt

@@ -0,0 +1,38 @@
+#lang racket/base
+(require "helper.rkt" "util.rkt" "number.rkt")
+(provide (all-defined-out))
+
+#|
+approximates
+https://github.com/mbutterick/restructure/blob/master/src/Buffer.coffee
+|#
+
+(define (xbuffer-decode xb [port-arg (current-input-port)] #:parent [parent #f])
+  (define port (->input-port port-arg))
+  (define decoded-len (resolve-length (xbuffer-len xb) port parent))
+  (read-bytes decoded-len port))
+
+(define (xbuffer-encode xb buf [port-arg (current-output-port)] #:parent [parent #f])
+  (define port (if (output-port? port-arg) port-arg (open-output-bytes)))
+  (unless (bytes? buf)
+    (raise-argument-error 'xbuffer-encode "bytes" buf))
+  (when (xint? (xbuffer-len xb))
+    (encode (xbuffer-len xb) (bytes-length buf) port))
+  (write-bytes buf port)
+  (unless port-arg (get-output-bytes port)))
+
+(define (xbuffer-size xb [val #f] [parent #f])
+  (when val (unless (bytes? val)
+              (raise-argument-error 'xbuffer-size "bytes" val)))
+  (if (bytes? val)
+      (bytes-length val)
+      (resolve-length (xbuffer-len xb) val parent)))
+
+(struct xbuffer (len) #:transparent
+  #:methods gen:xenomorphic
+  [(define decode xbuffer-decode)
+   (define encode xbuffer-encode)
+   (define size xbuffer-size)])
+
+(define (+xbuffer [len #xffff])
+  (xbuffer len))

xenomorph/xenomorph/redo/test/buffer-test.rkt

@@ -0,0 +1,44 @@
+#lang racket/base
+(require rackunit
+         sugar/unstable/dict
+         "../buffer.rkt"
+         "../number.rkt"
+         "../helper.rkt")
+
+#|
+approximates
+https://github.com/mbutterick/restructure/blob/master/test/Buffer.coffee
+|#
+
+(test-case
+ "buffer should decode"
+ (parameterize ([current-input-port (open-input-bytes (bytes #xab #xff #x1f #xb6))])
+   (define buf (+xbuffer 2))
+   (check-equal? (decode buf) (bytes #xab #xff))
+   (check-equal? (decode buf) (bytes #x1f #xb6))))
+
+(test-case
+ "buffer should decode with parent key length"
+ (parameterize ([current-input-port (open-input-bytes (bytes #xab #xff #x1f #xb6))])
+   (define buf (+xbuffer '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
+ "size should return size"
+ (check-equal? (size (+xbuffer 2) (bytes #xab #xff)) 2))
+
+(test-case
+ "size should use defined length if no value given"
+ (check-equal? (size (+xbuffer 10)) 10))
+
+(test-case
+ "encode should encode"
+ (let ([buf (+xbuffer 2)])
+   (check-equal? (bytes-append
+                  (encode buf (bytes #xab #xff) #f)
+                  (encode buf (bytes #x1f #xb6) #f)) (bytes #xab #xff #x1f #xb6))))
+
+(test-case
+ "encode should encode length before buffer"
+ (check-equal? (encode (+xbuffer uint8) (bytes #xab #xff) #f) (bytes 2 #xab #xff)))

xenomorph/xenomorph/redo/test/main.rkt

@@ -2,7 +2,7 @@
 
 (require "array-test.rkt"
          "bitfield-test.rkt"
-         ;"buffer-test.rkt"
+         "buffer-test.rkt"
          ;"enum-test.rkt"
          ;"lazy-array-test.rkt"
          "number-test.rkt"