leniency

5 years ago · ee21fdd131
parent f33c9e0296
commit ee21fdd131
3 changed files with 26 additions and 20 deletions
--- a/xenomorph/xenomorph/bitfield.rkt
+++ b/xenomorph/xenomorph/bitfield.rkt
@ -28,7 +28,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Bitfield.coffee

    (define/augment (x:decode port parent)
      (define val (send @type x:decode port))
-      (define flag-hash (mhasheq))
+      (define flag-hash (mhash))
      (for ([(flag idx) (in-indexed @flags)]
            #:when flag)
        (hash-set! flag-hash flag (bitwise-bit-set? val idx)))
@ -55,9 +55,9 @@ https://github.com/mbutterick/restructure/blob/master/src/Bitfield.coffee
                  #:base-class [base-class x:bitfield%])
  (()
   ((or/c x:int? #false)
-    (listof (or/c symbol? #false))
+    (listof any/c)
    #:type (or/c x:int? #false)
-    #:flags (listof (or/c symbol? #false))
+    #:flags (listof any/c)
    #: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%)))
@ -65,8 +65,6 @@ https://github.com/mbutterick/restructure/blob/master/src/Bitfield.coffee
   x:bitfield?)
  (define type (or type-arg type-kwarg))
  (define flags (or flag-arg flag-kwarg))
-  (unless (andmap (λ (f) (or (symbol? f) (not f))) flags)
-    (raise-argument-error 'x:bitfield "list containing symbols or #false values" flags))
  (new (generate-subclass base-class pre-proc post-proc)
       [type type]
       [flags flags]))
--- a/xenomorph/xenomorph/scribblings/xenomorph.scrbl
+++ b/xenomorph/xenomorph/scribblings/xenomorph.scrbl
@ -1105,7 +1105,7 @@ Create class instance that represents a bitfield format. See @racket[x:bitfield]
 (x:decode
 [input-port input-port?]
 [parent (or/c xenomorphic? #false)])
-hash-eq?]{
+hash?]{
 Returns a hash whose keys are the names of the flags, and whose values are Booleans.
 }

@ -1131,9 +1131,9 @@ Whether @racket[x] is an object of type @racket[x:bitfield%].
@defproc[
 (x:bitfield
 [type-arg (or/c x:int? #false) #false]
-[flags-arg (listof (or/c symbol? #false))]
+[flags-arg (listof any/c)]
 [#:type type-kw (or/c x:int? #false) uint8]
-[#:flags flags-kw (listof (or/c symbol? #false)) null]
+[#:flags flags-kw (listof any/c) null]
 [#: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%]
@ -1143,7 +1143,7 @@ Generate an instance of @racket[x:bitfield%] (or a subclass of @racket[x:bitfiel

@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 an @racket[x:int?]. Default is @racket[uint8].

-@racket[flags-arg] or @racket[flags-kw] (whichever is provided, though @racket[flags-arg] takes precedence) is a list of flag names corresponding to each bit. The number of names must be fewer than the number of bits in @racket[_type]. No name can be duplicated. Each name must be either a symbol or @racket[#false] (to indicate a skipped bit). Default is @racket[null].
+@racket[flags-arg] or @racket[flags-kw] (whichever is provided, though @racket[flags-arg] takes precedence) is a list of flag names corresponding to each bit. The number of names must be fewer than the number of bits in @racket[_type]. No name can be duplicated. Each flag name can be any value, but @racket[#false] indicates a skipped bit. Default is @racket[null].

@racket[pre-encode-proc] and @racket[post-decode-proc] control the pre-encoding and post-decoding procedures, respectively. Each takes as input the value to be processed and returns a new value.

--- a/xenomorph/xenomorph/test/bitfield-test.rkt
+++ b/xenomorph/xenomorph/test/bitfield-test.rkt
@ -13,7 +13,7 @@ approximates
 https://github.com/mbutterick/restructure/blob/master/test/Bitfield.coffee
 |#

-(define bitfield (x:bitfield uint8 '(Jack Kack Lack Mack Nack Oack Pack Quack)))
+(define bitfield (x:bitfield uint8 '(Jack Kack "Lack" Mack Nack Oack Pack Quack)))
 (match-define (list JACK KACK LACK MACK NACK OACK PACK QUACK)
  (map (λ (x) (arithmetic-shift 1 x)) (range 8)))

@ -21,12 +21,20 @@ https://github.com/mbutterick/restructure/blob/master/test/Bitfield.coffee
 "bitfield: should have the right size"
 (check-equal? (size bitfield) 1))

+(test-case
+ "bitfield: should reject too many flags"
+ (check-exn exn:fail? (λ () (x:bitfield uint8 '(Jack Kack Lack Mack Nack Oack Pack Quack Zack Wack)))))
+
+(test-case
+ "bitfield: should reject duplicate flags"
+ (check-exn exn:fail? (λ () (x:bitfield uint8 '(Jack Jack Jack Jack Jack)))))
+
 (test-case
 "bitfield: should decode"
 (parameterize ([current-input-port (open-input-bytes (bytes (bitwise-ior JACK MACK PACK NACK QUACK)))])
-   (check-equal? (decode bitfield) (mhasheq 'Quack #t
+   (check-equal? (decode bitfield) (mhash 'Quack #t
                                            'Nack #t
-                                            'Lack #f
+                                            "Lack" #f
                                            'Oack #f
                                            'Pack #t
                                            'Mack #t
@ -36,10 +44,10 @@ https://github.com/mbutterick/restructure/blob/master/test/Bitfield.coffee
 (test-case
 "bitfield: should decode with post-decode"
 (parameterize ([current-input-port (open-input-bytes (bytes (bitwise-ior JACK MACK PACK NACK QUACK)))])
-   (define bitfield (x:bitfield uint8 '(Jack Kack Lack Mack Nack Oack Pack Quack)                                                                      #:post-decode (λ (fh) (hash-set! fh 'foo 42) fh)))
-   (check-equal? (decode bitfield) (mhasheq 'Quack #t
+   (define bitfield (x:bitfield uint8 '(Jack Kack "Lack" Mack Nack Oack Pack Quack)                                                                      #:post-decode (λ (fh) (hash-set! fh 'foo 42) fh)))
+   (check-equal? (decode bitfield) (mhash 'Quack #t
                                            'Nack #t
-                                            'Lack #f
+                                            "Lack" #f
                                            'Oack #f
                                            'Pack #t
                                            'Mack #t
@ -49,9 +57,9 @@ https://github.com/mbutterick/restructure/blob/master/test/Bitfield.coffee

 (test-case
 "bitfield: should encode"
- (check-equal? (encode bitfield (mhasheq 'Quack #t
+ (check-equal? (encode bitfield (mhash 'Quack #t
                                         'Nack #t
-                                         'Lack #f
+                                         "Lack" #f
                                         'Oack #f
                                         'Pack #t
                                         'Mack #t
@ -61,15 +69,15 @@ https://github.com/mbutterick/restructure/blob/master/test/Bitfield.coffee

 (test-case
 "bitfield: should encode with pre-encode"
- (define bitfield (x:bitfield uint8 '(Jack Kack Lack Mack Nack Oack Pack Quack)
+ (define bitfield (x:bitfield uint8 '(Jack Kack "Lack" Mack Nack Oack Pack Quack)
                              #:pre-encode (λ (fh)
                                              (hash-set! fh 'Jack #f)
                                              (hash-set! fh 'Mack #f)
                                              (hash-set! fh 'Pack #f)
                                              fh)))
- (check-equal? (encode bitfield (mhasheq 'Quack #t
+ (check-equal? (encode bitfield (mhash 'Quack #t
                                         'Nack #t
-                                         'Lack #f
+                                         "Lack" #f
                                         'Oack #f
                                         'Pack #t
                                         'Mack #t