From e763a8cb285ba2d65600061ad0e9cd43bd4614ee Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 8 Jun 2017 10:12:10 -0700 Subject: [PATCH] a test --- pitfall/restructure/decodestream.rkt | 2 +- pitfall/restructure/helper.rkt | 16 ++++++++++- pitfall/restructure/main.rkt | 3 +- pitfall/restructure/number.rkt | 43 +++++++++++++++------------- pitfall/restructure/struct.rkt | 33 +++++++++++++++++---- pitfall/restructure/test.rkt | 22 ++++++++++++++ 6 files changed, 90 insertions(+), 29 deletions(-) create mode 100644 pitfall/restructure/test.rkt diff --git a/pitfall/restructure/decodestream.rkt b/pitfall/restructure/decodestream.rkt index 6a4c7a6d..a00eec85 100644 --- a/pitfall/restructure/decodestream.rkt +++ b/pitfall/restructure/decodestream.rkt @@ -20,7 +20,7 @@ -(define-subclass object% (DecodeStream [buffer #""]) +(define-subclass object% (RDecodeStream [buffer #""]) (field [pos 0] [length (bytes-length buffer)] ) diff --git a/pitfall/restructure/helper.rkt b/pitfall/restructure/helper.rkt index 9f6dbbf9..943c0db8 100644 --- a/pitfall/restructure/helper.rkt +++ b/pitfall/restructure/helper.rkt @@ -70,4 +70,18 @@ (define-syntax-rule (define-hashifier id hasher) (define (id . kvs) (hasher (listify kvs)))) (define-hashifier mhash make-hash) (define-hashifier mhasheq make-hasheq) -(define-hashifier mhasheqv make-hasheqv) \ No newline at end of file +(define-hashifier mhasheqv make-hasheqv) + +(define (port-position port) + (define-values (l c p) (port-next-location port)) + p) + +(define-syntax (· stx) + (syntax-case stx () + [(_ x ref) + #'(cond + [(object? x) (with-handlers ([exn:fail:object? (λ (exn) (send x ref))]) + (get-field ref x))] + [(hash? x) (hash-ref x 'ref #f)] + [else (raise-argument-error '· (format "~a must be object or hash" 'x) x)])] + [(_ x ref0 . refs) #'(· (· x ref0) . refs)])) \ No newline at end of file diff --git a/pitfall/restructure/main.rkt b/pitfall/restructure/main.rkt index 74affd7b..4fae76e2 100644 --- a/pitfall/restructure/main.rkt +++ b/pitfall/restructure/main.rkt @@ -1,4 +1,5 @@ #lang restructure/racket (r+p "number.rkt" - "struct.rkt") \ No newline at end of file + "struct.rkt" + "decodestream.rkt") \ No newline at end of file diff --git a/pitfall/restructure/number.rkt b/pitfall/restructure/number.rkt index a1d8bc86..63d25363 100644 --- a/pitfall/restructure/number.rkt +++ b/pitfall/restructure/number.rkt @@ -22,7 +22,7 @@ (getter-field [size (hash-ref type-sizes fn)]) - (define/override (decode stream) + (define/override (decode stream [res #f]) (unless (input-port? stream) (raise-argument-error 'decode "input port" stream)) (define bstr (read-bytes-exact size stream)) @@ -31,11 +31,14 @@ (integer-bytes->integer bstr (unsigned-type? type) (eq? endian 'BE)))) (define/override (encode stream val) - (unless (output-port? stream) - (raise-argument-error 'encode "output port" stream)) - (if (= 1 size) - (bytes val) - (integer->integer-bytes val size (unsigned-type? type) (eq? endian 'BE))))) + (when stream + (unless (output-port? stream) + (raise-argument-error 'encode "output port" stream))) + (define bstr + (if (= 1 size) + (bytes val) + (integer->integer-bytes val size (unsigned-type? type) (eq? endian 'BE)))) + (if stream (write-bytes bstr stream) bstr))) (test-module @@ -44,16 +47,16 @@ [op (open-output-bytes)]) (check-equal? (send o decode ip) 513) ;; 1000 0000 0100 0000 (check-equal? (send o decode ip) 1027) ;; 1100 0000 0010 0000 - (check-equal? (send o encode op 513) (bytes 1 2)) - (check-equal? (send o encode op 1027) (bytes 3 4))) + (check-equal? (send o encode #f 513) (bytes 1 2)) + (check-equal? (send o encode #f 1027) (bytes 3 4))) (let ([o (make-object Number 'UInt16 'BE)] [ip (open-input-bytes (bytes 1 2 3 4))] [op (open-output-bytes)]) (check-equal? (send o decode ip) 258) ;; 0100 0000 1000 0000 (check-equal? (send o decode ip) 772) ;; 0010 0000 1100 0000 - (check-equal? (send o encode op 258) (bytes 1 2)) - (check-equal? (send o encode op 772) (bytes 3 4)))) + (check-equal? (send o encode #f 258) (bytes 1 2)) + (check-equal? (send o encode #f 772) (bytes 3 4)))) (test-module @@ -68,17 +71,17 @@ ;; use keys of type-sizes hash to generate corresponding number definitions (define-macro (make-int-types) (with-pattern ([((ID BASE ENDIAN) ...) (for/list ([k (in-hash-keys type-sizes)]) - (define kstr (format "~a" k)) - (match-define (list* prefix suffix _) - (regexp-split #rx"(?=[BL]E|$)" kstr)) - (map string->symbol - (list (string-downcase kstr) - prefix - (if (positive? (string-length suffix)) - suffix - (if (system-big-endian?) "BE" "LE")))))] + (define kstr (format "~a" k)) + (match-define (list* prefix suffix _) + (regexp-split #rx"(?=[BL]E|$)" kstr)) + (map string->symbol + (list (string-downcase kstr) + prefix + (if (positive? (string-length suffix)) + suffix + (if (system-big-endian?) "BE" "LE")))))] [(ID ...) (suffix-id #'(ID ...) #:context caller-stx)]) - #'(begin (define+provide ID (make-object Number 'BASE 'ENDIAN)) ...))) + #'(begin (define+provide ID (make-object Number 'BASE 'ENDIAN)) ...))) (make-int-types) diff --git a/pitfall/restructure/struct.rkt b/pitfall/restructure/struct.rkt index 955dc9b8..91085678 100644 --- a/pitfall/restructure/struct.rkt +++ b/pitfall/restructure/struct.rkt @@ -8,12 +8,33 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee (define-subclass RBase (RStruct [fields (mhash)]) - (define/override (decode stream parent [length 0]) - (unfinished)) + (define/override (decode stream [parent #f] [length 0]) + (define res (_setup stream parent length)) + (_parseFields stream res fields) + (hash-set! (hash-ref res '_props) '_currentOffset (port-position stream)) + res) - (define/override (encode stream val parent) - (unfinished)) - ) + (define/override (encode stream val [parent #f]) + (for ([(key type) (in-hash fields)]) + (send type encode stream (hash-ref val key)))) + + (define/private (_setup stream parent length) + (define res (mhasheq)) + ;; define hidden properties + (hash-set! res '_props + (mhasheq 'parent (mhasheq 'value parent) + '_startOffset (mhasheq 'value (port-position stream)) + '_currentOffset (mhasheq 'value 0 'writable #t) + '_length (mhasheq 'value length))) + res) -(make-object RStruct (mhash 'foo "bar")) \ No newline at end of file + (define/private (_parseFields stream res field) + (for ([(key hashvalue) (in-hash fields)]) + (define val + (if (procedure? hashvalue) + (hashvalue res) + (send hashvalue decode stream res))) + (hash-set! res key val))) + + ) diff --git a/pitfall/restructure/test.rkt b/pitfall/restructure/test.rkt new file mode 100644 index 00000000..2f89e476 --- /dev/null +++ b/pitfall/restructure/test.rkt @@ -0,0 +1,22 @@ +#lang restructure/racket +(require "main.rkt") + +(define Person + (make-object RStruct + (mhash 'name uint16 + 'age uint8))) + +;; decode a person from a buffer +(define stream (open-input-bytes #"ABC")) +(define x (send Person decode stream)) + +(test-module + (check-equal? (hash-ref x 'name) 16961) + (check-equal? (hash-ref x 'age) 67)) + +;; encode a person from a hash +(define out (open-output-bytes)) +(send Person encode out (hasheq 'name 16961 'age 67)) + +(test-module + (check-equal? (get-output-bytes out) #"ABC")) \ No newline at end of file