pointer tests

xenomorph/xenomorph/helper.rkt

@@ -6,23 +6,10 @@
          "generic.rkt")
 (provide (all-defined-out))
 
-(define private-keys '(parent _startOffset _currentOffset _length))
-
-(define (dump-mutable x)
-  (define h (make-hasheq))
-  (for ([(k v) (in-dict (dump x))])
-       (hash-set! h k v))
-  h)
-
-(define (dump x)
-  (cond
-    [(input-port? x) (port->bytes x)]
-    [(output-port? x) (get-output-bytes x)]
-    [(dict? x) (for/hasheq ([(k v) (in-dict x)]
-                            #:unless (memq k private-keys))
-                           (values k v))]
-    [(list? x) (map dump x)]
-    [else x]))
+(define (dict-ref* d . keys)
+  (for/fold ([d d])
+            ([k (in-list keys)])
+    (dict-ref d k)))
 
 (define (pos p [new-pos #f])
   (when new-pos
@@ -39,7 +26,7 @@
                                             [(input-port? port-arg) port-arg]
                                             [(bytes? port-arg) (open-input-bytes port-arg)]
                                             [else (raise-argument-error 'decode "byte string or input port" port-arg)]))
-                                        (send xo xxdecode port parent))
+                                        (send xo decode port parent))
                                       
                                       (define (encode xo val [port-arg (current-output-port)]
                                                       #:parent [parent #f])
@@ -58,12 +45,15 @@
     
     (define/pubment (xxdecode input-port [parent #f])
       (post-decode (inner (error 'xxdecode-not-augmented) xxdecode input-port parent)))
+
+    (define/public (decode input-port [parent #f])
+      (xxdecode input-port parent))
     
     (define/pubment (xxencode val output-port [parent #f])
       (define encode-result (inner (error 'xxencode-not-augmented) xxencode (pre-encode val) output-port parent))
       (when (bytes? encode-result) (write-bytes encode-result output-port)))
     
-    (define/pubment (xxsize [val #f] [parent #f])
+    (define/pubment (xxsize [val #f] [parent #f] . _)
       (define size (inner 0 xxsize val parent))
       (unless (and (integer? size) (not (negative? size)))
         (raise-argument-error 'size "nonnegative integer" size))

xenomorph/xenomorph/test/pointer-test.rkt

@@ -1,10 +1,12 @@
 #lang debug racket/base
 (require rackunit
          racket/dict
+         racket/class
          "../helper.rkt"
          "../pointer.rkt"
          "../number.rkt"
          "../struct.rkt"
+         "../generic.rkt"
          racket/promise
          sugar/unstable/dict)
 
@@ -16,12 +18,12 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee
 (test-case
  "decode should handle null pointers"
  (parameterize ([current-input-port (open-input-bytes (bytes 0))])
-   (check-false (xdecode (+xpointer) #:parent (mhash '_startOffset 50)))))
+   (check-false (decode (+xpointer) #:parent (mhash '_startOffset 50)))))
 
 (test-case
  "decode should use local offsets from start of parent by default"
  (parameterize ([current-input-port (open-input-bytes (bytes 1 53))])
-   (check-equal? (xdecode (+xpointer) #:parent (mhash '_startOffset 0)) 53)))
+   (check-equal? (decode (+xpointer) #:parent (mhash '_startOffset 0)) 53)))
 
 (test-case
  "decode should support immediate offsets"
@@ -32,27 +34,24 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee
  "decode should support offsets relative to the parent"
  (parameterize ([current-input-port (open-input-bytes (bytes 0 0 1 53))])
    (pos (current-input-port) 2)
-   (check-equal? (xdecode (+xpointer #:relative-to 'parent)
-                         #:parent (mhash 'parent (mhash '_startOffset 2))) 53)))
+   (check-equal? (decode (+xpointer #:relative-to 'parent) #:parent (mhash 'parent (mhash '_startOffset 2))) 53)))
 
 (test-case
  "decode should support global offsets"
  (parameterize ([current-input-port (open-input-bytes (bytes 1 2 4 0 0 0 53))])
    (pos (current-input-port) 2)
-   (check-equal? (xdecode (+xpointer #:relative-to 'global)
-                         #:parent (mhash 'parent (mhash 'parent (mhash '_startOffset 2))))
+   (check-equal? (decode (+xpointer #:relative-to 'global) #:parent (mhash 'parent (mhash 'parent (mhash '_startOffset 2))))
                  53)))
 
 (test-case
  "decode should support returning pointer if there is no decode type"
  (parameterize ([current-input-port (open-input-bytes (bytes 4))])
-   (check-equal? (xdecode (+xpointer uint8 'void)
-                         #:parent (mhash '_startOffset 0)) 4)))
+   (check-equal? (decode (+xpointer uint8 'void) #:parent (mhash '_startOffset 0)) 4)))
 
 (test-case
  "decode should support decoding pointers lazily"
  (parameterize ([current-input-port (open-input-bytes (bytes 1 53))])
-   (define res (xdecode (+xstruct 'ptr (+xpointer #:lazy #t))))
+   (define res (decode (+xstruct 'ptr (+xpointer #:lazy #t))))
    (check-true (promise? (dict-ref res 'ptr)))
    (check-equal? (force (dict-ref res 'ptr)) 53)))