diff --git a/xenomorph/xenomorph/redo/buffer.rkt b/xenomorph/xenomorph/redo/buffer.rkt index c534a9f0..c3a7c47b 100644 --- a/xenomorph/xenomorph/redo/buffer.rkt +++ b/xenomorph/xenomorph/redo/buffer.rkt @@ -36,5 +36,9 @@ https://github.com/mbutterick/restructure/blob/master/src/Buffer.coffee (define encode xbuffer-encode) (define size xbuffer-size)]) -(define (+xbuffer [len #xffff]) +(define (+xbuffer [len-arg #f] + #:length [len-kwarg #f]) + (define len (or len-arg len-kwarg #xffff)) + (unless (length-resolvable? len) + (raise-argument-error '+xbuffer "resolvable length" len)) (xbuffer len)) \ No newline at end of file diff --git a/xenomorph/xenomorph/redo/enum.rkt b/xenomorph/xenomorph/redo/enum.rkt index 5cab0c07..c8394638 100644 --- a/xenomorph/xenomorph/redo/enum.rkt +++ b/xenomorph/xenomorph/redo/enum.rkt @@ -31,5 +31,13 @@ https://github.com/mbutterick/restructure/blob/master/src/Enum.coffee (define encode xenum-encode) (define size xenum-size)]) -(define (+xenum type [options null]) - (xenum type options)) \ No newline at end of file +(define (+xenum [type-arg #f] [values-arg #f] + #:type [type-kwarg #f] + #:values [values-kwarg #f]) + (define type (or type-arg type-kwarg)) + (unless (xenomorphic? type) + (raise-argument-error '+xenum "xenomorphic type" type)) + (define values (or values-arg values-kwarg)) + (unless (list? values) + (raise-argument-error '+xenum "list of values" values)) + (xenum type values)) \ No newline at end of file diff --git a/xenomorph/xenomorph/redo/optional.rkt b/xenomorph/xenomorph/redo/optional.rkt index 2ade74e5..7480a1d4 100644 --- a/xenomorph/xenomorph/redo/optional.rkt +++ b/xenomorph/xenomorph/redo/optional.rkt @@ -1,4 +1,4 @@ -#lang racket/base +#lang debug racket/base (require "helper.rkt") (provide (all-defined-out)) @@ -28,7 +28,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Optional.coffee (define/finalize-size (xoptional-size xo [val #f] #:parent [parent #f]) (when (resolve-condition xo parent) - (size (xoptional-type xo) val #:parent parent))) + (size (xoptional-type xo) val #:parent parent))) (struct xoptional xbase (type condition) #:transparent #:methods gen:xenomorphic @@ -36,5 +36,24 @@ https://github.com/mbutterick/restructure/blob/master/src/Optional.coffee (define encode xoptional-encode) (define size xoptional-size)]) -(define (+xoptional type [condition #t]) +#;(define (+xoptional [type-arg #f] [cond-arg #f] + #:type [type-kwarg #f] + #:condition [cond-kwarg #f]) + (define type (or type-arg type-kwarg)) + (unless (xenomorphic? type) + (raise-argument-error '+xoptional"xenomorphic type" type)) + (define condition (or cond-arg cond-kwarg)) + (xoptional type condition)) + +(define no-val (gensym)) +(define (+xoptional [type-arg #f] [cond-arg no-val] + #:type [type-kwarg #f] + #:condition [cond-kwarg no-val]) + (define type (or type-arg type-kwarg)) + (unless (xenomorphic? type) + (raise-argument-error '+xoptional"xenomorphic type" type)) + (define condition (cond + [(and (eq? cond-arg no-val) (eq? cond-kwarg no-val)) #true] + [(not (eq? cond-arg no-val)) cond-arg] + [(not (eq? cond-kwarg no-val)) cond-kwarg])) (xoptional type condition)) diff --git a/xenomorph/xenomorph/redo/test/buffer-test.rkt b/xenomorph/xenomorph/redo/test/buffer-test.rkt index 6f3851eb..d62a5266 100644 --- a/xenomorph/xenomorph/redo/test/buffer-test.rkt +++ b/xenomorph/xenomorph/redo/test/buffer-test.rkt @@ -13,14 +13,18 @@ https://github.com/mbutterick/restructure/blob/master/test/Buffer.coffee (test-case "buffer should decode" (parameterize ([current-input-port (open-input-bytes (bytes #xab #xff #x1f #xb6))]) - (define buf (+xbuffer 2)) + (define buf (+xbuffer #:length 2)) (check-equal? (decode buf) (bytes #xab #xff)) (check-equal? (decode buf) (bytes #x1f #xb6)))) +(test-case + "buffer should error on invalid length" + (check-exn exn:fail:contract? (λ () (+xbuffer #:length #true)))) + (test-case "buffer should decode with post-decode" (parameterize ([current-input-port (open-input-bytes (bytes #xab #xff #x1f #xb6))]) - (define buf (+xbuffer 2)) + (define buf (+xbuffer #:length 2)) (set-post-decode! buf (λ (bs) (bytes 1 2))) (check-equal? (decode buf) (bytes 1 2)) (check-equal? (decode buf) (bytes 1 2)))) @@ -28,17 +32,17 @@ https://github.com/mbutterick/restructure/blob/master/test/Buffer.coffee (test-case "buffer should decode with parent key length" (parameterize ([current-input-port (open-input-bytes (bytes #xab #xff #x1f #xb6))]) - (define buf (+xbuffer 'len)) + (define buf (+xbuffer #:length 'len)) (check-equal? (decode buf #:parent (hash 'len 3)) (bytes #xab #xff #x1f)) (check-equal? (decode buf #:parent (hash 'len 1)) (bytes #xb6)))) (test-case "size should return size" - (check-equal? (size (+xbuffer 2) (bytes #xab #xff)) 2)) + (check-equal? (size (+xbuffer #:length 2) (bytes #xab #xff)) 2)) (test-case "size should use defined length if no value given" - (check-equal? (size (+xbuffer 10)) 10)) + (check-equal? (size (+xbuffer #:length 10)) 10)) (test-case "encode should encode" @@ -57,4 +61,4 @@ https://github.com/mbutterick/restructure/blob/master/test/Buffer.coffee (test-case "encode should encode length before buffer" - (check-equal? (encode (+xbuffer uint8) (bytes #xab #xff) #f) (bytes 2 #xab #xff))) \ No newline at end of file + (check-equal? (encode (+xbuffer #:length uint8) (bytes #xab #xff) #f) (bytes 2 #xab #xff))) \ No newline at end of file diff --git a/xenomorph/xenomorph/redo/test/enum-test.rkt b/xenomorph/xenomorph/redo/test/enum-test.rkt index fae02125..7fd73d22 100644 --- a/xenomorph/xenomorph/redo/test/enum-test.rkt +++ b/xenomorph/xenomorph/redo/test/enum-test.rkt @@ -10,7 +10,16 @@ approximates https://github.com/mbutterick/restructure/blob/master/test/Enum.coffee |# -(define e (+xenum uint8 '("foo" "bar" "baz"))) +(define e (+xenum #:type uint8 + #:values '("foo" "bar" "baz"))) + +(test-case + "should error with invalid type" + (check-exn exn:fail:contract? (λ () (+xenum 42)))) + +(test-case + "should error with invalid values" + (check-exn exn:fail:contract? (λ () (+xenum #:values 42)))) (test-case "should have the right size" diff --git a/xenomorph/xenomorph/redo/test/optional-test.rkt b/xenomorph/xenomorph/redo/test/optional-test.rkt index 5806167c..e3749772 100644 --- a/xenomorph/xenomorph/redo/test/optional-test.rkt +++ b/xenomorph/xenomorph/redo/test/optional-test.rkt @@ -12,14 +12,14 @@ https://github.com/mbutterick/restructure/blob/master/test/Optional.coffee (test-case "decode should not decode when condition is falsy" (parameterize ([current-input-port (open-input-bytes (bytes 0))]) - (define optional (+xoptional uint8 #f)) + (define optional (+xoptional #:type uint8 #:condition #f)) (check-equal? (decode optional) (void)) (check-equal? (pos (current-input-port)) 0))) (test-case "decode with post-decode" (parameterize ([current-input-port (open-input-bytes (bytes 0))]) - (define optional (+xoptional uint8 #f)) + (define optional (+xoptional #:type uint8 #:condition #f)) (set-post-decode! optional (λ (val) 42)) (check-equal? (decode optional) 42) (check-equal? (pos (current-input-port)) 0))) @@ -27,62 +27,62 @@ https://github.com/mbutterick/restructure/blob/master/test/Optional.coffee (test-case "decode should not decode when condition is a function and falsy" (parameterize ([current-input-port (open-input-bytes (bytes 0))]) - (define optional (+xoptional uint8 (λ _ #f))) + (define optional (+xoptional #:type uint8 #:condition (λ _ #f))) (check-equal? (decode optional) (void)) (check-equal? (pos (current-input-port)) 0))) (test-case "decode should decode when condition is omitted" (parameterize ([current-input-port (open-input-bytes (bytes 0))]) - (define optional (+xoptional uint8)) + (define optional (+xoptional #:type uint8)) (check-not-equal? (decode optional) (void)) (check-equal? (pos (current-input-port)) 1))) (test-case "decode should decode when condition is truthy" (parameterize ([current-input-port (open-input-bytes (bytes 0))]) - (define optional (+xoptional uint8 #t)) + (define optional (+xoptional #:type uint8 #:condition #t)) (check-not-equal? (decode optional) (void)) (check-equal? (pos (current-input-port)) 1))) (test-case "decode should decode when condition is a function and truthy" (parameterize ([current-input-port (open-input-bytes (bytes 0))]) - (define optional (+xoptional uint8 (λ _ #t))) + (define optional (+xoptional #:type uint8 #:condition (λ _ #t))) (check-not-equal? (decode optional) (void)) (check-equal? (pos (current-input-port)) 1))) (test-case "size" - (check-equal? (size (+xoptional uint8 #f)) 0)) + (check-equal? (size (+xoptional #:type uint8 #:condition #f)) 0)) (test-case "size should return 0 when condition is a function and falsy" - (check-equal? (size (+xoptional uint8 (λ _ #f))) 0)) + (check-equal? (size (+xoptional #:type uint8 #:condition (λ _ #f))) 0)) (test-case "size should return given type size when condition is omitted" - (check-equal? (size (+xoptional uint8)) 1)) + (check-equal? (size (+xoptional #:type uint8)) 1)) (test-case "size should return given type size when condition is truthy" - (check-equal? (size (+xoptional uint8 #t)) 1)) + (check-equal? (size (+xoptional #:type uint8 #:condition #t)) 1)) (test-case "size should return given type size when condition is a function and truthy" - (check-equal? (size (+xoptional uint8 (λ _ #t))) 1)) + (check-equal? (size (+xoptional #:type uint8 #:condition (λ _ #t))) 1)) (test-case "encode should not encode when condition is falsy" (parameterize ([current-output-port (open-output-bytes)]) - (define optional (+xoptional uint8 #f)) + (define optional (+xoptional #:type uint8 #:condition #f)) (encode optional 128) (check-equal? (dump (current-output-port)) (bytes)))) (test-case "encode with pre-encode" (parameterize ([current-output-port (open-output-bytes)]) - (define optional (+xoptional uint8)) + (define optional (+xoptional #:type uint8)) (set-pre-encode! optional (λ (val) 42)) (encode optional 128) (check-equal? (dump (current-output-port)) (bytes 42)))) @@ -90,27 +90,27 @@ https://github.com/mbutterick/restructure/blob/master/test/Optional.coffee (test-case "encode should not encode when condition is a function and falsy" (parameterize ([current-output-port (open-output-bytes)]) - (define optional (+xoptional uint8 (λ _ #f))) + (define optional (+xoptional #:type uint8 #:condition (λ _ #f))) (encode optional 128) (check-equal? (dump (current-output-port)) (bytes)))) (test-case "encode should encode when condition is omitted" (parameterize ([current-output-port (open-output-bytes)]) - (define optional (+xoptional uint8)) + (define optional (+xoptional #:type uint8)) (encode optional 128) (check-equal? (dump (current-output-port)) (bytes 128)))) (test-case "encode should encode when condition is truthy" (parameterize ([current-output-port (open-output-bytes)]) - (define optional (+xoptional uint8 #t)) + (define optional (+xoptional #:type uint8 #:condition #t)) (encode optional 128) (check-equal? (dump (current-output-port)) (bytes 128)))) (test-case "encode should encode when condition is a function and truthy" (parameterize ([current-output-port (open-output-bytes)]) - (define optional (+xoptional uint8 (λ _ #t))) + (define optional (+xoptional #:type uint8 #:condition (λ _ #t))) (encode optional 128) (check-equal? (dump (current-output-port)) (bytes 128)))) \ No newline at end of file