From 1192f7692e19683f5879a578aaa0ea02861d2b7d Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 28 Jun 2017 22:28:50 -0700 Subject: [PATCH] resume in subversioned structs --- pitfall/restructure/generic.rkt | 3 + pitfall/restructure/main.rkt | 2 + pitfall/restructure/versioned-struct-test.rkt | 78 +++++++++ pitfall/restructure/versioned-struct.rkt | 159 ++++++++++-------- 4 files changed, 171 insertions(+), 71 deletions(-) diff --git a/pitfall/restructure/generic.rkt b/pitfall/restructure/generic.rkt index 5b03c113..b67a19f8 100644 --- a/pitfall/restructure/generic.rkt +++ b/pitfall/restructure/generic.rkt @@ -16,6 +16,9 @@ ([hash? (define ref hash-ref) (define ref-set! hash-set!) (define ref-keys hash-keys)] + [dict? (define ref dict-ref) + (define ref-set! dict-set!) + (define ref-keys dict-keys)] [object? (define (ref o i) (with-handlers ([exn:fail:object? (位 (exn) (hash-ref (get-field _hash o) i))]) (dynamic-get-field i o))) (define (ref-set! o i v) (with-handlers ([exn:fail:object? (位 (exn) (hash-set! (get-field _hash o) i v))]) (dynamic-set-field! i o v))) (define (ref-keys o) (append (remove '_hash (field-names o)) (hash-keys (get-field _hash o))))])) diff --git a/pitfall/restructure/main.rkt b/pitfall/restructure/main.rkt index 94118079..3c08a7f2 100644 --- a/pitfall/restructure/main.rkt +++ b/pitfall/restructure/main.rkt @@ -3,6 +3,7 @@ (r+p "base.rkt" "number.rkt" "struct.rkt" + "versioned-struct.rkt" "string.rkt" "array.rkt" "lazy-array.rkt" @@ -14,6 +15,7 @@ (test-module (require "number-test.rkt" "struct-test.rkt" + "versioned-struct-test.rkt" "string-test.rkt" "array-test.rkt" "lazy-array-test.rkt" diff --git a/pitfall/restructure/versioned-struct-test.rkt b/pitfall/restructure/versioned-struct-test.rkt index a9434bad..093dc1a4 100644 --- a/pitfall/restructure/versioned-struct-test.rkt +++ b/pitfall/restructure/versioned-struct-test.rkt @@ -30,6 +30,28 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe ; name: 'devon 馃憤' ; age: 21 ; gender: 0 + +(let ([struct (+VersionedStruct uint8 + (dictify + 0 (dictify 'name (+StringT uint8 'ascii) + 'age uint8) + 1 (dictify 'name (+StringT uint8 'utf8) + 'age uint8 + 'gender uint8)))]) + + (let ([stream (+DecodeStream (+Buffer "\u0000\u0005devon\u0015"))]) + (check-equal? (send (send struct decode stream) ht) (mhasheq 'name "devon" + 'age 21 + 'version 0))) + + (let ([stream (+DecodeStream (+Buffer "\u0001\u000adevon 馃憤\u0015\u0000"))]) + (check-equal? (send (send struct decode stream) ht) (mhasheq 'name "devon 馃憤" + 'age 21 + 'version 1 + 'gender 0)))) + + + ; ; it 'should throw for unknown version', -> ; struct = new VersionedStruct uint8, @@ -44,6 +66,19 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe ; stream = new DecodeStream new Buffer '\x05\x05devon\x15' ; should.throw -> ; struct.decode(stream) + + +(let ([struct (+VersionedStruct uint8 + (dictify + 0 (dictify 'name (+StringT uint8 'ascii) + 'age uint8) + 1 (dictify 'name (+StringT uint8 'utf8) + 'age uint8 + 'gender uint8)))]) + + (let ([stream (+DecodeStream (+Buffer "\u0005\u0005devon\u0015"))]) + (check-exn exn:fail:contract? (位 () (send struct decode stream))))) + ; ; it 'should support common header block', -> ; struct = new VersionedStruct uint8, @@ -70,6 +105,29 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe ; alive: 1 ; name: 'devon 馃憤' ; gender: 0 + + +(let ([struct (+VersionedStruct uint8 + (dictify + 'header (dictify 'age uint8 + 'alive uint8) + 0 (dictify 'name (+StringT uint8 'ascii)) + 1 (dictify 'name (+StringT uint8 'utf8) + 'gender uint8)))]) + + (let ([stream (+DecodeStream (+Buffer "\u0000\u0015\u0001\u0005devon"))]) + (check-equal? (send (send struct decode stream) ht) (mhasheq 'name "devon" + 'age 21 + 'alive 1 + 'version 0))) + + (let ([stream (+DecodeStream (+Buffer "\u0001\u0015\u0001\u000adevon 馃憤\u0000"))]) + (check-equal? (send (send struct decode stream) ht) (mhasheq 'name "devon 馃憤" + 'age 21 + 'version 1 + 'alive 1 + 'gender 0)))) + ; ; it 'should support parent version key', -> ; struct = new VersionedStruct 'version', @@ -93,6 +151,26 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe ; name: 'devon 馃憤' ; age: 21 ; gender: 0 + +(let ([struct (+VersionedStruct 'version + (dictify + 0 (dictify 'name (+StringT uint8 'ascii) + 'age uint8) + 1 (dictify 'name (+StringT uint8 'utf8) + 'age uint8 + 'gender uint8)))]) + + (let ([stream (+DecodeStream (+Buffer "\u0005devon\u0015"))]) + (check-equal? (send (send struct decode stream (mhash 'version 0)) ht) (mhasheq 'name "devon" + 'age 21 + 'version 0))) + + (let ([stream (+DecodeStream (+Buffer "\u000adevon 馃憤\u0015\u0000" 'utf8))]) + (check-equal? (send (send struct decode stream (mhash 'version 1)) ht) (mhasheq 'name "devon 馃憤" + 'age 21 + 'version 1 + 'gender 0)))) + ; ; it 'should support sub versioned structs', -> ; struct = new VersionedStruct uint8, diff --git a/pitfall/restructure/versioned-struct.rkt b/pitfall/restructure/versioned-struct.rkt index f28bf724..fd16f878 100644 --- a/pitfall/restructure/versioned-struct.rkt +++ b/pitfall/restructure/versioned-struct.rkt @@ -8,45 +8,47 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee |# (define-subclass Struct (VersionedStruct type [versions (dictify)]) + (unless ((disjoin integer? procedure? RestructureBase? symbol?) type) (raise-argument-error 'VersionedStruct "integer, function, symbol, or Restructure object" type)) (unless (and (dict? versions) (andmap (位 (val) (or (dict? val) (Struct? val))) (map cdr versions))) (raise-argument-error 'VersionedStruct "dict of dicts or Structs" versions)) + + (inherit _setup _parseFields process) (inherit-field fields) - (field [forced-version #f]) - - (define/public-final (force-version! version) - (set! forced-version version)) + (field [forced-version #f] + [versionGetter void] + [versionSetter void]) + + (when (symbol? type) ; instead of string + (set-field! versionGetter this (位 (parent) (ref parent type))) + (set-field! versionSetter this (位 (parent version) (ref-set! parent type version)))) - (define/public (resolve-version [stream #f] [parent #f]) - (cond - [forced-version] ; for testing purposes: pass an explicit version - [(integer? type) type] - [(symbol? type) - ;; find the first Struct in the chain of ancestors - ;; with the target key - (let loop ([x parent]) - (cond - [(and x (Struct? x) (dict-ref (路 x res) type #f))] - [(路 x parent) => loop] - [else #f]))] - [(and (procedure? type) (positive? (procedure-arity type))) (type parent)] - [(RestructureBase? type) (send type decode stream)] - [else (raise-argument-error 'VersionedStruct:resolve-version "way of finding version" type)])) - (define/override (decode stream [parent #f] [length 0]) - (set! res (send this _setup stream parent length)) - (report res 'versioned-struct-res) - (define version (resolve-version stream parent)) - (hash-set! res 'version version) - (define fields (dict-ref versions version (位 () (raise-argument-error 'VersionedStruct:decode "valid version key" (cons version (路 this versions)))))) + (define res (_setup stream parent length)) + + (ref-set! res 'version + (cond + [forced-version] ; for testing purposes: pass an explicit version + [(symbol? type) (unless parent + (raise-argument-error 'VersionedStruct:decode "valid parent" parent)) + (versionGetter parent)] + [else (send type decode stream)])) + + (when (dict-ref versions 'header #f) + (_parseFields stream res (ref versions 'header))) + + (define fields (dict-ref versions (ref res 'version) (位 () (raise-argument-error 'VersionedStruct:decode "valid version key" (cons version (路 this versions)))))) + (cond [(VersionedStruct? fields) (send fields decode stream parent)] [else - (report res 'whatigot) - (send this _parseFields stream res fields) - (send this process res stream) + (_parseFields stream res fields) + (process res stream) res])) + + (define/public-final (force-version! version) + (set! forced-version version)) (define/override (encode stream input-hash [parent #f]) (unless (hash? input-hash) @@ -66,49 +68,64 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee [else (send fields encode stream input-hash parent)])) - (define/override (size [input-hash (mhash)] [parent #f] [includePointers #t]) - (when (and (not input-hash) (not forced-version)) + (define/override (size [val (mhash)] [parent #f] [includePointers #t]) + (unless (or val forced-version) (error 'VersionedStruct-cannot-compute-size)) - (define version (resolve-version #f parent)) - (define fields (dict-ref versions version (位 () (raise-argument-error 'VersionedStruct:size "valid version key" version)))) - (cond - [(dict? fields) - (for/sum ([(key type) (in-dict fields)]) - (define val (hash-ref input-hash key #f)) - (define args (if val (list val) empty)) - (send type size . args))] - [else (send fields size input-hash parent includePointers)]))) - -(test-module - (require "number.rkt") - (define (random-pick xs) (list-ref xs (random (length xs)))) - (check-exn exn:fail:contract? (位 () (+VersionedStruct 42 42))) - - ;; make random versioned structs and make sure we can round trip - (for ([i (in-range 20)]) - (define field-types (for/list ([i (in-range 200)]) - (random-pick (list uint8 uint16be uint16le uint32be uint32le double)))) - (define num-versions 20) - (define which-struct (random num-versions)) - (define struct-versions (for/list ([v (in-range num-versions)]) - (cons v (for/list ([num-type (in-list field-types)]) - (cons (gensym) num-type))))) - (define vs (+VersionedStruct which-struct struct-versions)) - (define struct-size (for/sum ([num-type (in-list (map cdr (dict-ref struct-versions which-struct)))]) - (send num-type size))) - (define bs (apply bytes (for/list ([i (in-range struct-size)]) - (random 256)))) - (check-equal? (send vs encode #f (send vs decode bs)) bs)) - - (define s (+Struct (dictify 'a uint8 'b uint8 'c uint8))) - (check-equal? (send s size) 3) - (define vs (+VersionedStruct (位 (p) 2) (dictify 1 (dictify 'd s) 2 (dictify 'e s 'f s)))) - (check-equal? (send vs size) 6) - (define s2 (+Struct (dictify 'a vs))) - (check-equal? (send s2 size) 6) - (define vs2 (+VersionedStruct (位 (p) 2) (dictify 1 vs 2 vs))) - (check-equal? (send vs2 size) 6) - - ) + + (define ctx (mhash 'parent parent + 'val val + 'pointerSize 0)) + + (define size 0) + (when (not (string? type)) + (increment! size (send type size (ref val 'version) ctx))) + + (when (ref versions 'header) + (increment! size + (for/sum ([(key type) (in-dict (ref versions 'header))]) + (send type size (ref val key) ctx)))) + + (define fields (dict-ref versions (ref val 'version) (位 () (raise-argument-error 'VersionedStruct:encode "valid version key" version)))) + + (increment! size + (for/sum ([(key type) (in-dict (ref versions 'header))]) + (send type size (ref val key) ctx))) + + (when includePointers + (increment! size (ref ctx 'pointerSize))) + + size)) + +#;(test-module + (require "number.rkt") + (define (random-pick xs) (list-ref xs (random (length xs)))) + (check-exn exn:fail:contract? (位 () (+VersionedStruct 42 42))) + + ;; make random versioned structs and make sure we can round trip + (for ([i (in-range 20)]) + (define field-types (for/list ([i (in-range 200)]) + (random-pick (list uint8 uint16be uint16le uint32be uint32le double)))) + (define num-versions 20) + (define which-struct (random num-versions)) + (define struct-versions (for/list ([v (in-range num-versions)]) + (cons v (for/list ([num-type (in-list field-types)]) + (cons (gensym) num-type))))) + (define vs (+VersionedStruct which-struct struct-versions)) + (define struct-size (for/sum ([num-type (in-list (map cdr (dict-ref struct-versions which-struct)))]) + (send num-type size))) + (define bs (apply bytes (for/list ([i (in-range struct-size)]) + (random 256)))) + (check-equal? (send vs encode #f (send vs decode bs)) bs)) + + (define s (+Struct (dictify 'a uint8 'b uint8 'c uint8))) + (check-equal? (send s size) 3) + (define vs (+VersionedStruct (位 (p) 2) (dictify 1 (dictify 'd s) 2 (dictify 'e s 'f s)))) + (check-equal? (send vs size) 6) + (define s2 (+Struct (dictify 'a vs))) + (check-equal? (send s2 size) 6) + (define vs2 (+VersionedStruct (位 (p) 2) (dictify 1 vs 2 vs))) + (check-equal? (send vs2 size) 6) + + )