shithub: fnt

Info  •  Files  •  Log  •  Branches

check the values validity if defined, even with unused fields

--- a/otf.rkt

+++ b/otf.rkt

@@ -59,6 +59,9 @@

 (define (field-ptr f)

   (if (field-count f) "*" ""))

+(define (field-values f)

+  (assoc '= (field-attrs f)))

+

 (define-struct field (type name attrs)

   #:transparent

   #:methods gen:code

@@ -74,23 +77,37 @@

      (define (size t)

        (if (type? t) (type-size t) 0))

      (define (name t)

-       (if (type? t) (type-name t) (cmplx-name t)))

-     (list (match (field-count f)

-             [#f

-              (if (field-unused? f)

-                  (~a "if(skip_bytes(ctx, " (size (field-type f)) ") < 0){")

-                  (~a "if(read_" (name (field-type f)) "(ctx, &v->" (field-name f) ") < 0){"))]

-             [count

-              (~a "if(read_array(ctx, &v->"

-                  (field-name f)

-                  ", read_"

-                  (super-c-type (field-type f))

-                  ", v->"

-                  (cadr count)

-                  ") < 0){")])

-           (~a "\twerror(\"%s: %r\", \"" (field-name f) "\");")

-           (~a "\tgoto err;")

-           (~a "}")))])

+       (if (type? t) (super-c-type t) (cmplx-name t)))

+     (define ref (~a (if (field-unused? f) "" "v->") (field-name f)))

+     (define declared (and (field-unused? f) (field-values f)))

+     (define (format-number x)

+       (if (and (>= x -32767) (<= x 32768)) (~r x) (~r x #:base 16 #:sign '("0x" "" "-0x"))))

+     (list* (if declared (list (~a (name (field-type f)) " " ref ";")) empty)

+            (match (field-count f)

+              [#f

+               (if (or declared (not (field-unused? f)))

+                   (~a "if(read_" (name (field-type f)) "(ctx, &" ref ") < 0){")

+                   (~a "if(skip_bytes(ctx, " (size (field-type f)) ") < 0){"))]

+              [count

+               (~a "if(read_array(ctx, &"

+                   ref

+                   ", read_"

+                   (super-c-type (field-type f))

+                   ", v->"

+                   (cadr count)

+                   ") < 0){")])

+            (~a "\twerror(\"%s: %r\", \"" (field-name f) "\");")

+            (~a "\tgoto err;")

+            (match (field-values f)

+              [(list '= a ...)

+               (list (~a "}")

+                     (~a "if("

+                         (string-join (map (λ (v) (~a ref " != " (format-number v))) a) " && ")

+                         "){")

+                     (~a "\twerror(\"%s: invalid value: %d\", \"" (field-name f) "\", " ref ");")

+                     (~a "\tgoto err;")

+                     (~a "}"))]

+              [#f (list (~a "}"))])))])

 (define-struct cmplx (name fields tag)

   #:transparent