mbutterick
/
typesetting
2
1
Fork 0
Code Issues 13 Pull Requests Projects Releases Wiki Activity

adjust the field names of x:pointer

Browse Source
main
Matthew Butterick 6 years ago
parent 9640111ffc
commit 740d6506f4
8 changed files with 187 additions and 85 deletions
Show Stats Download Patch File Download Diff File

46
xenomorph/xenomorph/bitfield.rkt
Unescape Escape View File

@ -1,5 +1,10 @@
#lang racket/base
(require "base.rkt" racket/class racket/dict sugar/unstable/dict)
(require "base.rkt"
"int.rkt"
racket/class
racket/dict
racket/contract
sugar/unstable/dict)
(provide (all-defined-out))
#|
@ -10,9 +15,8 @@ https://github.com/mbutterick/restructure/blob/master/src/Bitfield.coffee
(define x:bitfield%
(class x:base%
(super-new)
(init-field [(@type type)][(@flags flags)])
(unless (andmap (λ (f) (or (symbol? f) (not f))) @flags)
(raise-argument-error '+xbitfield "list of symbols" @flags))
(init-field [(@type type)]
[(@flags flags)])
(define/augment (x:decode port parent)
(define val (send @type x:decode port))
@ -30,16 +34,34 @@ https://github.com/mbutterick/restructure/blob/master/src/Bitfield.coffee
(define/augment (x:size [val #f] [parent #f])
(send @type x:size))))
(define (x:bitfield? x) (is-a? x x:bitfield%))
(define (x:bitfield [type-arg #f] [flag-arg #f]
#:type [type-kwarg #f]
#:flags [flag-kwarg #f]
#:pre-encode [pre-proc #f]
#:post-decode [post-proc #f]
#:base-class [base-class x:bitfield%])
(define/contract (x:bitfield
[type-arg #f]
[flag-arg #f]
#:type [type-kwarg uint8]
#:flags [flag-kwarg null]
#:pre-encode [pre-proc #f]
#:post-decode [post-proc #f]
#:base-class [base-class x:bitfield%])
(()
((or/c x:int? #false)
(listof (or/c symbol? #false))
#:type (or/c x:int? #false)
#:flags (listof (or/c symbol? #false))
#:pre-encode (or/c (any/c . -> . any/c) #false)
#:post-decode (or/c (any/c . -> . any/c) #false)
#:base-class (λ (c) (subclass? c x:bitfield%)))
. ->* .
x:bitfield?)
(define type (or type-arg type-kwarg))
(define flags (or flag-arg flag-kwarg null))
(new (generate-subclass base-class pre-proc post-proc) [type type] [flags flags]))
(define flags (or flag-arg flag-kwarg))
(unless (andmap (λ (f) (or (symbol? f) (not f))) flags)
(raise-argument-error 'x:bitfield "list of symbols" flags))
(new (generate-subclass base-class pre-proc post-proc)
[type type]
[flags flags]))
(module+ test
(require rackunit "number.rkt" "base.rkt")

49
xenomorph/xenomorph/pointer.rkt
Unescape Escape View File

@ -4,6 +4,7 @@
racket/dict
racket/class
racket/promise
racket/match
racket/contract
sugar/unstable/dict)
(provide (all-defined-out))
@ -32,31 +33,31 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee
(define x:pointer%
(class x:base%
(super-new)
(init-field [(@offset-type offset-type)]
[(@type type)]
(init-field [(@ptr-val-type ptr-type)]
[(@dest-type dest-type)]
[(@pointer-relative-to pointer-relative-to)]
[(@allow-null? allow-null?)]
[(@null-value null-value)]
[(@pointer-lazy? pointer-lazy?)])
(define/augride (x:decode port parent)
(define offset (send @offset-type x:decode port parent))
(define offset (send @ptr-val-type x:decode port parent))
(cond
[(and @allow-null? (= offset @null-value)) #false] ; handle null pointers
[else
(define relative (+ (case @pointer-relative-to
[(local) (hash-ref parent x:start-offset-key)]
[(immediate) (- (pos port) (send @offset-type x:size))]
[(immediate) (- (pos port) (send @ptr-val-type x:size))]
[(parent) (hash-ref (hash-ref parent x:parent-key) x:start-offset-key)]
[(global) (or (hash-ref (find-top-parent parent) x:start-offset-key) 0)]
[else (error 'unknown-pointer-style)])))
(define ptr (+ offset relative))
(cond
[@type (define (decode-value)
[@dest-type (define (decode-value)
(define orig-pos (pos port))
(pos port ptr)
(begin0
(send @type x:decode port parent)
(send @dest-type x:decode port parent)
(pos port orig-pos)))
(if @pointer-lazy? (delay (decode-value)) (decode-value))]
[else ptr])]))
@ -73,15 +74,15 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee
[else (error 'unknown-pointer-style)]))
(define relative (+ (case @pointer-relative-to
[(local parent) (hash-ref new-parent x:start-offset-key)]
[(immediate) (+ (pos port) (send @offset-type x:size val-in parent))]
[(immediate) (+ (pos port) (send @ptr-val-type x:size val-in parent))]
[(global) 0])))
(send @offset-type x:encode (- (hash-ref new-parent x:pointer-offset-key) relative) port)
(define-values (type val) (resolve-pointer @type val-in))
(send @ptr-val-type x:encode (- (hash-ref new-parent x:pointer-offset-key) relative) port)
(define-values (type val) (resolve-pointer @dest-type val-in))
(hash-update! new-parent x:pointers-key
(λ (ptrs) (append ptrs (list (x:ptr type val parent)))))
(hash-set! new-parent x:pointer-offset-key
(+ (hash-ref new-parent x:pointer-offset-key) (send type x:size val parent)))]
[else (send @offset-type x:encode @null-value port)]))
[else (send @ptr-val-type x:encode @null-value port)]))
(define/augride (x:size [val-in #f] [parent #f])
(define new-parent (case @pointer-relative-to
@ -89,12 +90,12 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee
[(parent) (hash-ref parent x:parent-key)]
[(global) (find-top-parent parent)]
[else (error 'unknown-pointer-style)]))
(define-values (type val) (resolve-pointer @type val-in))
(define-values (type val) (resolve-pointer @dest-type val-in))
(when (and val new-parent)
(hash-set! new-parent x:pointer-size-key
(and (hash-ref new-parent x:pointer-size-key #f)
(+ (hash-ref new-parent x:pointer-size-key) (send type x:size val new-parent)))))
(send @offset-type x:size))))
(send @ptr-val-type x:size))))
#|
The arguments here are renamed slightly compared to the original.
@ -115,10 +116,10 @@ This allows the pointer to be calculated relative to a property on the parent. I
(define (x:pointer? x) (is-a? x x:pointer%))
(define/contract (x:pointer
[offset-arg #f]
[type-arg #f]
#:offset-type [offset-kwarg uint8]
#:type [type-kwarg uint32]
[ptr-type-arg #f]
[dest-type-arg #f]
#:type [ptr-type-kwarg uint32]
#:dest-type [dest-type-kwarg uint8]
#:relative-to [pointer-relative-to 'local]
#:lazy [pointer-lazy? #f]
#:allow-null [allow-null? #t]
@ -127,10 +128,11 @@ This allows the pointer to be calculated relative to a property on the parent. I
#:post-decode [post-proc #f]
#:base-class [base-class x:pointer%])
(()
((or/c xenomorphic? #false)
(or/c x:int? 'void #false)
#:offset-type (or/c xenomorphic? #false)
#:type (or/c x:int? 'void #false)
(
(or/c x:int? #false)
(or/c xenomorphic? 'void #false)
#:type (or/c x:int? #false)
#:dest-type (or/c xenomorphic? 'void #false)
#:relative-to pointer-relative-value?
#:lazy boolean?
#:allow-null boolean?
@ -142,10 +144,11 @@ This allows the pointer to be calculated relative to a property on the parent. I
x:pointer?)
(unless (pointer-relative-value? pointer-relative-to)
(raise-argument-error 'x:pointer (format "~v" valid-pointer-relatives) pointer-relative-to))
(define type-in (or type-arg type-kwarg))
(new (generate-subclass base-class pre-proc post-proc)
[offset-type (or offset-arg offset-kwarg)]
[type (case type-in [(void) #f][else type-in])]
[ptr-type (or ptr-type-arg ptr-type-kwarg)]
[dest-type (match (or dest-type-arg dest-type-kwarg)
['void #false]
[type-in type-in])]
[pointer-relative-to pointer-relative-to]
[pointer-lazy? pointer-lazy?]
[allow-null? allow-null?]

107
xenomorph/xenomorph/scribblings/xenomorph.scrbl
Unescape Escape View File

@ -1008,8 +1008,8 @@ Whether @racket[x] can be used as a value for the @racket[_pointer-relative-to]
}
@defconstructor[
([offset-type xenomorphic?]
[type x:int?]
([ptr-type x:int?]
[dest-type (or/c xenomorphic? 'void)]
[pointer-relative-to pointer-relative-value?]
[allow-null? boolean?]
[null-value any/c]
@ -1050,10 +1050,10 @@ Whether @racket[x] is an object of type @racket[x:pointer%].
@defproc[
(x:pointer
[offset-arg (or/c xenomorphic? #false) #false]
[type-arg (or/c x:int? 'void #false) #false]
[#:offset-type offset-kw (or/c xenomorphic? #false) uint8]
[#:type type-kw (or/c x:int? 'void #false) uint32]
[ptr-type-arg (or/c x:int? #false) #false]
[dest-type-arg (or/c xenomorphic? 'void #false) #false]
[#:type ptr-type-kw (or/c x:int? #false) uint32]
[#:dest-type dest-type-kw (or/c xenomorphic? 'void #false) uint8]
[#:relative-to pointer-relative-to pointer-relative-value? 'local]
[#:allow-null allow-null? boolean? #true]
[#:null null-value any/c 0]
@ -1065,9 +1065,10 @@ Whether @racket[x] is an object of type @racket[x:pointer%].
x:pointer?]{
Generate an instance of @racket[x:pointer%] (or a subclass of @racket[x:pointer%]) with certain optional attributes.
@racket[offset-arg] or @racket[offset-kw] (whichever is provided, though @racket[offset-arg] takes precedence) controls the type of the thing being pointed at. Default is @racket[uint8].
@racket[ptr-dest-type-arg] or @racket[ptr-type-kw] (whichever is provided, though @racket[ptr-dest-type-arg] takes precedence) controls the type of the pointer value itself, which must be an @racket[x:int?]). Default is @racket[uint32].
@racket[dest-type-arg] or @racket[dest-type-kw] (whichever is provided, though @racket[dest-type-arg] takes precedence) controls the type of the thing being pointed at, which must be a @racket[xenomorphic?] object or the symbol @racket['void] to indicate a void pointer. Default is @racket[uint8].
@racket[type-arg] or @racket[type-kw] (whichever is provided, though @racket[type-arg] takes precedence) controls the type of the pointer value itself, which must be either an @racket[x:int?] or the symbol @racket['void] to indicate a void pointer). Default is @racket[uint32].
@racket[pointer-relative-to] controls the style of pointer, which must be one of @racket['(local immediate parent global)]. Default is @racket['local].
@ -1075,11 +1076,6 @@ Generate an instance of @racket[x:pointer%] (or a subclass of @racket[x:pointer%
@racket[pointer-lazy?] controls whether the pointer is decoded immediately. If @racket[pointer-lazy?] is @racket[#true], then the decoding of the pointer is wrapped in a @tech{promise} that can later be evaluated with @racket[force]. Default is @racket[#false].
@racket[len-arg] or @racket[len-kw] (whichever is provided, though @racket[len-arg] takes precedence) determines the length of the pointer. This can be an ordinary integer, but it can also be any value that is @racket[length-resolvable?].
@racket[pre-encode-proc] and @racket[post-decode-proc] control the pre-encoding and post-decodeing procedures, respectively.
@racket[base-class] controls the class used for instantiation of the new object.
@ -1091,6 +1087,91 @@ Generate an instance of @racket[x:pointer%] (or a subclass of @racket[x:pointer%
@defmodule[xenomorph/bitfield]
A @deftech{bitfield} is a compact encoding for Boolean values, where each bit of an integer indicates @racket[#true] or @racket[#false] (depending on whether its value is @racket[1] or @racket[0]).
@defclass[x:bitfield% x:base% ()]{
Base class for bitfield formats. Use @racket[x:bitfield] to conveniently instantiate new bitfield formats.
@defproc[
(bitfield-relative-value?
[x any/c])
boolean?]{
Whether @racket[x] can be used as a value for the @racket[_bitfield-relative-to] field of @racket[x:bitfield%]. Valid choices are @racket['(local immediate parent global)].
}
@defconstructor[
([offset-type xenomorphic?]
[type x:int?]
[bitfield-relative-to bitfield-relative-value?]
[allow-null? boolean?]
[null-value any/c]
[bitfield-lazy? boolean?])]{
Create class instance that represents a bitfield format. See @racket[x:bitfield] for a description of the fields.
}
@defmethod[
#:mode extend
(x:decode
[input-port input-port?]
[parent (or/c xenomorphic? #false)])
bitfield?]{
Returns a @tech{bitfield} of values whose length is @racket[_len] and where each value is @racket[_type].
}
@defmethod[
#:mode extend
(x:encode
[seq sequence?]
[input-port input-port?]
[parent (or/c xenomorphic? #false)])
bytes?]{
Take a @tech{sequence} @racket[seq] and encode it as a @tech{byte string}.
}
}
@defproc[
(x:bitfield?
[x any/c])
boolean?]{
Whether @racket[x] is an object of type @racket[x:bitfield%].
}
@defproc[
(x:bitfield
[ptr-type-arg (or/c xenomorphic? #false) #false]
[type-arg (or/c x:int? 'void #false) #false]
[#:type ptr-type-kw (or/c xenomorphic? #false) uint8]
[#:type type-kw (or/c x:int? 'void #false) uint32]
[#:relative-to bitfield-relative-to bitfield-relative-value? 'local]
[#:allow-null allow-null? boolean? #true]
[#:null null-value any/c 0]
[#:lazy bitfield-lazy? boolean? #false]
[#:pre-encode pre-encode-proc (or/c (any/c . -> . any/c) #false) #false]
[#:post-decode post-decode-proc (or/c (any/c . -> . any/c) #false) #false]
[#:base-class base-class (λ (c) (subclass? c x:bitfield%)) x:bitfield%]
)
x:bitfield?]{
Generate an instance of @racket[x:bitfield%] (or a subclass of @racket[x:bitfield%]) with certain optional attributes.
@racket[ptr-type-arg] or @racket[ptr-type-kw] (whichever is provided, though @racket[ptr-type-arg] takes precedence) controls the type of the thing being pointed at. Default is @racket[uint8].
@racket[type-arg] or @racket[type-kw] (whichever is provided, though @racket[type-arg] takes precedence) controls the type of the bitfield value itself, which must be either an @racket[x:int?] or the symbol @racket['void] to indicate a void bitfield). Default is @racket[uint32].
@racket[bitfield-relative-to] controls the style of bitfield, which must be one of @racket['(local immediate parent global)]. Default is @racket['local].
@racket[allow-null?] controls whether the bitfield can take on null values, and @racket[null-value] controls what that value is. Defaults are @racket[#true] and @racket[0], respectively.
@racket[bitfield-lazy?] controls whether the bitfield is decoded immediately. If @racket[bitfield-lazy?] is @racket[#true], then the decoding of the bitfield is wrapped in a @tech{promise} that can later be evaluated with @racket[force]. Default is @racket[#false].
@racket[pre-encode-proc] and @racket[post-decode-proc] control the pre-encoding and post-decodeing procedures, respectively.
@racket[base-class] controls the class used for instantiation of the new object.
}
@subsection{Enumerations}

26
xenomorph/xenomorph/test/dict-test.rkt
Unescape Escape View File

@ -15,14 +15,14 @@ https://github.com/mbutterick/restructure/blob/master/test/Struct.coffee
|#
(test-case
"struct: decode into an object"
"dict: decode into an object"
(parameterize ([current-input-port (open-input-bytes #"\x05roxyb\x15")])
(check-equal?
(decode (x:dict 'name (x:string #:length uint8) 'age uint8))
(mhasheq 'name "roxyb" 'age 21))))
(test-case
"struct: decode nested struct into an object"
"dict: decode nested struct into an object"
(parameterize ([current-input-port (open-input-bytes #"\x05roxyb\x15\x05roxyb\x15")])
(check-equal?
(decode (x:dict 'name (x:string #:length uint8) 'age uint8
@ -30,7 +30,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Struct.coffee
(mhasheq 'name "roxyb" 'age 21 'nested (mhasheq 'name "roxyb" 'age 21)))))
(test-case
"struct: decode with process hook"
"dict: decode with process hook"
(parameterize ([current-input-port (open-input-bytes #"\x05roxyb\x20")])
(define struct (x:dict #:post-decode (λ (o) (hash-set! o 'canDrink (>= (hash-ref o 'age) 21)) o)
'name (x:string #:length uint8) 'age uint8))
@ -38,40 +38,40 @@ https://github.com/mbutterick/restructure/blob/master/test/Struct.coffee
(mhasheq 'name "roxyb" 'age 32 'canDrink #t))))
(test-case
"struct: decode supports function keys"
"dict: decode supports function keys"
(parameterize ([current-input-port (open-input-bytes #"\x05roxyb\x20")])
(define struct (x:dict 'name (x:string #:length uint8) 'age uint8 'canDrink (λ (o) (>= (hash-ref o 'age) 21))))
(check-equal? (decode struct)
(mhasheq 'name "roxyb" 'age 32 'canDrink #t))))
(test-case
"struct: compute the correct size"
"dict: compute the correct size"
(check-equal? (size (x:dict 'name (x:string #:length uint8) 'age uint8)
(hasheq 'name "roxyb" 'age 32)) 7))
(test-case
"struct: compute the correct size with pointers"
"dict: compute the correct size with pointers"
(check-equal? (size (x:dict 'name (x:string #:length uint8)
'age uint8
'ptr (x:pointer #:type (x:string #:length uint8)))
'ptr (x:pointer #:type uint8 #:dest-type (x:string #:length uint8)))
(mhash 'name "roxyb" 'age 21 'ptr "hello")) 14))
(test-case
"struct: get the correct size when no value is given"
"dict: get the correct size when no value is given"
(check-equal? (size (x:dict 'name (x:string 4) 'age uint8)) 5))
(test-case
"struct: throw when getting non-fixed length size and no value is given"
"dict: throw when getting non-fixed length size and no value is given"
(check-exn exn:fail:contract? (λ () (size (x:dict 'name (x:string #:length uint8) 'age uint8)))))
(test-case
"struct: encode objects to buffers"
"dict: encode objects to buffers"
(parameterize ([current-input-port (open-input-bytes #"\x05roxyb\x15")])
(check-equal? (decode (x:dict 'name (x:string #:length uint8) 'age uint8))
(mhasheq 'name "roxyb" 'age 21))))
(test-case
"struct: support pre-encode hook"
"dict: support pre-encode hook"
(parameterize ([current-output-port (open-output-bytes)])
(define struct (x:dict #:pre-encode (λ (val)
(hash-set! val 'nameLength (string-length (hash-ref val 'name))) val)
@ -82,10 +82,10 @@ https://github.com/mbutterick/restructure/blob/master/test/Struct.coffee
(check-equal? (get-output-bytes (current-output-port)) #"\x05roxyb\x15")))
(test-case
"struct: encode pointer data after structure"
"dict: encode pointer data after structure"
(parameterize ([current-output-port (open-output-bytes)])
(define struct (x:dict 'name (x:string #:length uint8)
'age uint8
'ptr (x:pointer #:type (x:string #:length uint8))))
'ptr (x:pointer uint8 #:dest-type (x:string #:length uint8))))
(encode struct (hasheq 'name "roxyb" 'age 21 'ptr "hello"))
(check-equal? (get-output-bytes (current-output-port)) #"\x05roxyb\x15\x08\x05hello")))

7
xenomorph/xenomorph/test/list-test.rkt
Unescape Escape View File

@ -110,7 +110,6 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee
(check-equal? (encode (x:list #:type uint8 #:length uint8) '(1 2 3 4) #f) (bytes 4 1 2 3 4)))
(test-case
"list: add pointers after array if length is encoded at start"
(check-equal? (encode (x:list #:type (x:pointer #:offset-type uint8
#:type uint8)
#:length uint8) '(1 2 3 4) #f) (bytes 4 5 6 7 8 1 2 3 4)))
"list: add pointers after array if length is encoded at start"
(check-equal? (encode (x:list #:type (x:pointer uint8 uint8)
#:length uint8) '(1 2 3 4) #f) (bytes 4 5 6 7 8 1 2 3 4)))

28
xenomorph/xenomorph/test/pointer-test.rkt
Unescape Escape View File

@ -23,18 +23,18 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee
(test-case
"pointer: decode should use local offsets from start of parent by default"
(parameterize ([current-input-port (open-input-bytes (bytes 1 53))])
(check-equal? (decode (x:pointer) #:parent (mhash x:start-offset-key 0)) 53)))
(check-equal? (decode (x:pointer uint8) #:parent (mhash x:start-offset-key 0)) 53)))
(test-case
"pointer: decode should support immediate offsets"
(parameterize ([current-input-port (open-input-bytes (bytes 1 53))])
(check-equal? (decode (x:pointer #:relative-to 'immediate)) 53)))
(check-equal? (decode (x:pointer uint8 #:relative-to 'immediate)) 53)))
(test-case
"pointer: 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? (decode (x:pointer #:relative-to 'parent) #:parent (mhash x:parent-key (mhash x:start-offset-key 2))) 53)))
(check-equal? (decode (x:pointer uint8 #:relative-to 'parent) #:parent (mhash x:parent-key (mhash x:start-offset-key 2))) 53)))
(test-case
"pointer: decode should support global offsets"
@ -54,32 +54,32 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee
(test-case
"pointer: decode should support decoding pointers lazily"
(parameterize ([current-input-port (open-input-bytes (bytes 1 53))])
(define res (decode (x:dict 'ptr (x:pointer #:lazy #t))))
(define res (decode (x:dict 'ptr (x:pointer uint8 #:lazy #t))))
(check-true (promise? (hash-ref res 'ptr)))
(check-equal? (force (hash-ref res 'ptr)) 53)))
(test-case
"pointer: size"
(let ([parent (mhash x:pointer-size-key 0)])
(check-equal? (size (x:pointer #:type uint8) 10 #:parent parent) 1)
(check-equal? (size (x:pointer uint8) 10 #:parent parent) 1)
(check-equal? (hash-ref parent x:pointer-size-key) 1)))
(test-case
"pointer: size should add to immediate pointerSize"
(let ([parent (mhash x:pointer-size-key 0)])
(check-equal? (size (x:pointer #:relative-to 'immediate #:type uint8) 10 #:parent parent) 1)
(check-equal? (size (x:pointer uint8 #:relative-to 'immediate) 10 #:parent parent) 1)
(check-equal? (hash-ref parent x:pointer-size-key) 1)))
(test-case
"pointer: size should add to parent pointerSize"
(let ([parent (mhash x:parent-key (mhash x:pointer-size-key 0))])
(check-equal? (size (x:pointer #:relative-to 'parent #:type uint8) 10 #:parent parent) 1)
(check-equal? (size (x:pointer uint8 #:relative-to 'parent) 10 #:parent parent) 1)
(check-equal? (hash-ref* parent x:parent-key x:pointer-size-key) 1)))
(test-case
"pointer: size should add to global pointerSize"
(let ([parent (mhash x:parent-key (mhash x:parent-key (mhash x:parent-key (mhash x:pointer-size-key 0))))])
(check-equal? (size (x:pointer #:relative-to 'global #:type uint8) 10 #:parent parent) 1)
(check-equal? (size (x:pointer uint8 #:relative-to 'global) 10 #:parent parent) 1)
(check-equal? (hash-ref* parent x:parent-key x:parent-key x:parent-key x:pointer-size-key) 1)))
(test-case
@ -95,7 +95,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee
(test-case
"pointer: size should return a fixed size without a value"
(check-equal? (size (x:pointer)) 1))
(check-equal? (size (x:pointer uint8)) 1))
(test-case
"pointer: encode should handle null pointers"
@ -104,7 +104,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee
x:start-offset-key 0
x:pointer-offset-key 0
x:pointers-key null))
(encode (x:pointer) #f #:parent parent)
(encode (x:pointer uint8) #f #:parent parent)
(check-equal? (hash-ref parent x:pointer-size-key) 0)
(check-equal? (get-output-bytes (current-output-port)) (bytes 0))))
@ -115,7 +115,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee
x:start-offset-key 0
x:pointer-offset-key 1
x:pointers-key null))
(encode (x:pointer #:type uint8) 10 #:parent parent)
(encode (x:pointer uint8) 10 #:parent parent)
(check-equal? (hash-ref parent x:pointer-offset-key) 2)
(check-equal? (hash-ref parent x:pointers-key) (list (x:ptr uint8 10 parent)))
(check-equal? (get-output-bytes (current-output-port)) (bytes 1))))
@ -127,7 +127,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee
x:start-offset-key 0
x:pointer-offset-key 1
x:pointers-key null))
(encode (x:pointer #:relative-to 'immediate #:type uint8) 10 #:parent parent)
(encode (x:pointer uint8 #:relative-to 'immediate) 10 #:parent parent)
(check-equal? (hash-ref parent x:pointer-offset-key) 2)
(check-equal? (hash-ref parent x:pointers-key) (list (x:ptr uint8 10 parent)))
(check-equal? (get-output-bytes (current-output-port)) (bytes 0))))
@ -139,7 +139,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee
x:start-offset-key 3
x:pointer-offset-key 5
x:pointers-key null)))
(encode (x:pointer #:relative-to 'parent #:type uint8) 10 #:parent parent)
(encode (x:pointer uint8 #:relative-to 'parent) 10 #:parent parent)
(check-equal? (hash-ref* parent x:parent-key x:pointer-offset-key) 6)
(check-equal? (hash-ref* parent x:parent-key x:pointers-key) (list (x:ptr uint8 10 parent)))
(check-equal? (get-output-bytes (current-output-port)) (bytes 2))))
@ -153,7 +153,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee
x:start-offset-key 3
x:pointer-offset-key 5
x:pointers-key null)))))
(encode (x:pointer #:relative-to 'global #:type uint8) 10 #:parent parent)
(encode (x:pointer uint8 #:relative-to 'global) 10 #:parent parent)
(check-equal? (hash-ref* parent x:parent-key x:parent-key x:parent-key x:pointer-offset-key) 6)
(check-equal? (hash-ref* parent x:parent-key x:parent-key x:parent-key x:pointers-key)
(list (x:ptr uint8 10 parent)))

3
xenomorph/xenomorph/test/vector-test.rkt
Unescape Escape View File

@ -112,6 +112,5 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee
(test-case
"vector: add pointers after array if length is encoded at start"
(check-equal? (encode (x:vector #:type (x:pointer #:offset-type uint8
#:type uint8)
(check-equal? (encode (x:vector #:type (x:pointer uint8 #:dest-type uint8)
#:length uint8) '#(1 2 3 4) #f) (bytes 4 5 6 7 8 1 2 3 4)))

6
xenomorph/xenomorph/test/versioned-dict-test.rkt
Unescape Escape View File

@ -177,8 +177,7 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
'age uint8)
1 (x:dict 'name (x:string #:length uint8 #:encoding 'utf8)
'age uint8
'ptr (x:pointer #:offset-type uint8
#:type (x:string uint8)))))])
'ptr (x:pointer uint8 #:dest-type (x:string uint8)))))])
(check-equal? (size vstruct (mhasheq 'name "roxyb"
'age 21
x:version-key 1
@ -243,8 +242,7 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
'age uint8)
1 (x:dict 'name (x:string #:length uint8 #:encoding 'utf8)
'age uint8
'ptr (x:pointer #:offset-type uint8
#:type (x:string uint8)))))]
'ptr (x:pointer uint8 #:dest-type (x:string uint8)))))]
[op (open-output-bytes)])
(encode vstruct (mhasheq x:version-key 1 'name "roxyb" 'age 21 'ptr "hello") op)

Write Preview
Loading…
Cancel
Save