shithub: fnt

Info  •  Files  •  Log  •  Branches

shorter tests

--- a/otf.rkt

+++ b/otf.rkt

@@ -60,8 +60,8 @@

 (define (field-count f)

   (assoc 'count (field-attrs f)))

-(define (field-values f)

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

+(define (field-test f)

+  (filter (λ (t) (eq? (car t) 'test)) (field-attrs f)))

 (define (field-verb f)

   (assoc 'verb (field-attrs f)))

@@ -115,6 +115,14 @@

          (~a "fprint_" (cmplx-name t) "(f, indent+indentΔ, &v->" (field-name f) array-index ");"))))

   (if (field-unused? f) empty (wrap-cond-c (field-cond f) (array-loop lst))))

+(define (invert-c op)

+  (match op

+    ['= '!=]

+    ['<= '>]

+    ['>= '<]

+    ['< '>=]

+    ['> '<=]))

+

 (define-struct field (type name attrs)

   #:transparent

   #:methods gen:code

@@ -135,7 +143,7 @@

      (define (name t)

        (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 declared (and (field-unused? f) (not (empty? (field-test f)))))

      (define (format-number x)

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

      (define (parse-if-error read)

@@ -165,25 +173,31 @@

               "), v->"

               (cadr count)

               ") < 0){")]))

+     (define (test-cond ts)

+       (map (λ (t)

+              (match t

+                [(list 'test op a ...)

+                 (string-join (map (λ (v) (~a ref " " (invert-c op) " " (format-number v))) a)

+                              " && ")]))

+            ts))

      (list*

       (parse-if-error #t)

       (if index

           empty

           (list (~a "\twerrstr(\"%s: %r\", \"" (field-name f) "\");") (~a "\tgoto err;") (~a "}")))

-      (match (field-values f)

-        [(list '= a ...)

-         (list

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

-          (~a "\twerrstr(\"%s: invalid value: %d (0x%ux)\", \""

-              (field-name f)

-              "\", "

-              ref

-              ", "

-              ref

-              ");")

-          (~a "\tgoto err;")

-          (~a "}"))]

-        [#f empty])))])

+      (match (test-cond (field-test f))

+        [(list) empty]

+        [(list a ...)

+         (list (~a "if(" (string-join a " || ") "){")

+               (~a "\twerrstr(\"%s: invalid value: %d (0x%ux)\", \""

+                   (field-name f)

+                   "\", "

+                   ref

+                   ", "

+                   ref

+                   ");")

+               (~a "\tgoto err;")

+               (~a "}"))])))])

 (define (filter-extra extra key)

   (flatten (filter-map (λ (e) (and (eq? (car e) key) (cdr e))) extra)))

@@ -298,7 +312,7 @@

   (syntax-parse stx

     [(_ (n:number)) #''(count n)]

     [(_ {~literal hex}) #''(verb "%#ux")]

-    [(_ ({~literal =} vs:number ...+)) #''(= vs ...)]

+    [(_ (p:expr vs:number ...+)) #''(test p vs ...)]

     [(_ (p:expr ref:id n:number))

      #''(cond

           p

@@ -365,7 +379,7 @@

           (~a "(" x ">>14)+(" x "&((1<<14)-1))/16384.0")))

 (mkcmplx EncodingRecord

-         (mkfields {uint16 platformID (= 0 1 2 3 4)} {uint16 encodingID} {Offset32 subtableOffset}))

+         (mkfields {uint16 platformID (<= 4)} {uint16 encodingID} {Offset32 subtableOffset}))

 (mkcmplx TableCmap

          (mkfields {uint16 version unused (= 0)}

@@ -389,19 +403,19 @@

                    {int16 yMax}

                    {uint16 macStyle}

                    {uint16 lowestRecPPEM}

-                   {int16 fontDirectionHint unused (= -2 -1 0 1 2)}

-                   {int16 indexToLocFormat (= 0 1)}

+                   {int16 fontDirectionHint unused (>= -2) (<= 2)}

+                   {int16 indexToLocFormat (<= 1)}

                    {int16 glyphDataFormat unused (= 0)})

          #:tag "head")

 (mkcmplx TableMaxp

-         (mkfields {Version16Dot16 version (= #x05000 #x10000)}

+         (mkfields {Version16Dot16 version (= #x05000 #x10000) hex}

                    {uint16 numGlyphs} ; FIXME there are more fields here, depending on the version

                    )

          #:tag "maxp")

 (mkcmplx TableOS∕2

-         (mkfields {uint16 version (= 0 1 2 3 4 5)}

+         (mkfields {uint16 version (<= 5)}

                    {FWORD xAvgCharWidth}

                    {uint16 usWeightClass}

                    {uint16 usWidthClass}