diff --git a/xenomorph/xenomorph/helper.rkt b/xenomorph/xenomorph/helper.rkt index 256e7a6c..e1ca83a6 100644 --- a/xenomorph/xenomorph/helper.rkt +++ b/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)) diff --git a/xenomorph/xenomorph/test/pointer-test.rkt b/xenomorph/xenomorph/test/pointer-test.rkt index 3e1d319f..b514d35b 100644 --- a/xenomorph/xenomorph/test/pointer-test.rkt +++ b/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)))