rearrange tests

pitfall/fontkit/font.rkt

@@ -10,8 +10,13 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
 (require (for-syntax "tables.rkt"))
 (define-macro (define-table-getters)
   (with-pattern ([(TABLE-TAG ...) (hash-keys table-codecs)])
-    #'(begin
-        (define/public (TABLE-TAG) (_getTable 'TABLE-TAG)) ...)))
+                #'(begin
+                    (define/public (TABLE-TAG) (_getTable 'TABLE-TAG)) ...)))
+
+
+(test-module
+ (define f (openSync (path->string charter-path)))
+ (check-equal? (postscriptName f) "Charter"))
 
 ;; This is the base class for all SFNT-based font formats in fontkit.
 ;;  It supports TrueType, and PostScript glyphs, and several color glyph formats.
@@ -96,63 +101,80 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
   (->m number?)
   (· this head unitsPerEm))
 
+(test-module
+ (check-equal? (· f unitsPerEm) 1000))
 
 ;; The font’s [ascender](https://en.wikipedia.org/wiki/Ascender_(typography))
 (define/contract (ascent this)
   (->m number?)
   (· this hhea ascent))
 
+(test-module
+ (check-equal? (· f ascent) 980))
+
 
 ;; The font’s [descender](https://en.wikipedia.org/wiki/Descender)
 (define/contract (descent this)
   (->m number?)
   (· this hhea descent))
 
+(test-module
+ (check-equal? (· f descent) -238))
 
 ;; The amount of space that should be included between lines
 (define/contract (lineGap this)
   (->m number?)
   (· this hhea lineGap))
 
+(test-module
+ (check-equal? (· f lineGap) 0))
+
 
 (define/contract (underlinePosition this)
   (->m number?)
-  (define post-table (cast (FT_Get_Sfnt_Table (· this ft-face) 'ft_sfnt_post) _pointer _FT_TT_Postscript-pointer))
-  (FT_TT_Postscript-underlinePosition post-table))
+  (· this post underlinePosition))
 
+(test-module
+ (check-equal? (· f underlinePosition) -178))
 
 
 (define/contract (underlineThickness this)
   (->m number?)
-  (define post-table (cast (FT_Get_Sfnt_Table (· this ft-face) 'ft_sfnt_post) _pointer _FT_TT_Postscript-pointer))
-  (FT_TT_Postscript-underlineThickness post-table))
+  (· this post underlineThickness))
+
+(test-module
+ (check-equal? (· f underlineThickness) 58))
 
 
 ;; If this is an italic font, the angle the cursor should be drawn at to match the font design
 (define/contract (italicAngle this)
   (->m number?)
-  (define post-table (cast (FT_Get_Sfnt_Table (· this ft-face) 'ft_sfnt_post) _pointer _FT_TT_Postscript-pointer))
-  (FT_TT_Postscript-italicAngle post-table))
+  (· this post italicAngle))
+
+(test-module
+ (check-equal? (· f italicAngle) 0))
 
 
 ;; The height of capital letters above the baseline.
 (define/contract (capHeight this)
   (->m number?)
-  (cond
-    [(send this has-table? #"OS/2")
-     (define os2-table (cast (FT_Get_Sfnt_Table (· this ft-face) 'ft_sfnt_os2) _pointer _FT_TT_OS2-pointer))
-     (FT_TT_OS2-sCapHeight os2-table)]
-    [else (· this ascent)]))
+  (if (send this has-table? #"OS/2")
+      (· this OS/2 capHeight)
+      (· this ascent)))
+
+(test-module
+ (check-equal? (· f capHeight) 671))
 
 
 ;; The height of lower case letters in the font.
 (define/contract (xHeight this)
   (->m number?)
-  (cond
-    [(send this has-table? #"OS/2")
-     (define os2-table (cast (FT_Get_Sfnt_Table (· this ft-face) 'ft_sfnt_os2) _pointer _FT_TT_OS2-pointer))
-     (FT_TT_OS2-sxHeight os2-table)]
-    [else 0]))
+  (if (send this has-table? #"OS/2")
+      (· this OS/2 xHeight)
+      0))
+
+(test-module
+ (check-equal? (· f xHeight) 481))
 
 
 ;; The font’s bounding box, i.e. the box that encloses all glyphs in the font.
@@ -163,6 +185,9 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
     (· this head xMax)
     (· this head yMax)))
 
+(test-module
+ (check-equal? (bbox->list (· f bbox)) '(-161 -236 1193 963)))
+
 
 (define/contract (_cmapProcessor this)
   (->m (is-a?/c CmapProcessor))
@@ -189,6 +214,12 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
 (define has-gpos-table? (curryr has-table? 'GPOS))
 (define has-gsub-table? (curryr has-table? 'GSUB))
 
+(test-module
+ (check-false (· f has-cff-table?))
+ (check-false (· f has-morx-table?))
+ (check-false (· f has-gsub-table?))
+ (check-false (· f has-gpos-table?)))
+
 
 ;; Returns a glyph object for the given glyph id.
 ;; You can pass the array of code points this glyph represents for
@@ -205,6 +236,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
   ((string?) ((or/c (listof symbol?) #f) (or/c symbol? #f) (or/c symbol? #f)) . ->*m . (is-a?/c GlyphRun))
   (unless (· this _layoutEngine)
     (set-field! _layoutEngine this (make-object LayoutEngine this)))
+  (report 'in-layout)
   (send (· this _layoutEngine) layout string userFeatures script language))
 
 
@@ -226,7 +258,6 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
 ;; Does not perform any advanced substitutions (there is no context to do so).
 (define/contract (glyphForCodePoint this codePoint)
   (index? . ->m . (is-a?/c Glyph))
-  #;(FT_Select_Charmap (· this ft-face) (tag->int #"unic"))
   (define glyph-idx (FT_Get_Char_Index (· this ft-face) codePoint))
   (send this getGlyph glyph-idx (list codePoint)))
 
@@ -278,27 +309,6 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
 
 
 (test-module
- (define f (openSync (path->string charter-path)))
- (check-equal? (postscriptName f) "Charter")
- (check-equal? (· f unitsPerEm) 1000)
- (check-equal? (· f ascent) 980)
- (check-equal? (· f descent) -238)
- (check-equal? (bbox->list (· f bbox)) '(-161 -236 1193 963))
  (check-equal? (measure-string f "f" (· f unitsPerEm)) 321.0)
- (check-false (· f has-cff-table?))
- (check-false (· f has-morx-table?))
- (check-false (· f has-gsub-table?))
- (check-false (· f has-gpos-table?))
  (check-true (send f has-table? #"cmap"))
- (check-equal? (· f lineGap) 0)
- (check-exn exn:fail:contract? (λ () (send f _getTable 'nonexistent-table-tag)))
- #;(send f _getTable 'maxp)
- (define subset (make-object TTFSubset f))
- (define es (+EncodeStream))
- (send subset encode es)
- #;(with-output-to-file "subsetfont.rktd" (λ () (display (send es dump)) ))
- #;(check-equal? (send es dump) (file->bytes "subsetfont.rktd"))
-
- (file-directory-decode "subsetfont.rktd")
- (file-directory-decode "../pitfall/test/out.bin")
- )
+ (check-exn exn:fail:contract? (λ () (send f _getTable 'nonexistent-table-tag))))