From 567bf6a8f920d2b11ac75f0313fa540b36f7b6c0 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 11 Jun 2017 22:27:45 -0700 Subject: [PATCH] next: make unit tests for struct type --- pitfall/fontkit/fpgm.rkt | 1 - pitfall/fontkit/helper.rkt | 2 +- pitfall/fontkit/hhea.rkt | 1 - pitfall/fontkit/hmtx.rkt | 3 +- pitfall/fontkit/loca.rkt | 1 - pitfall/fontkit/maxp.rkt | 1 - pitfall/fontkit/prep.rkt | 80 +--------------------------------- pitfall/fontkit/tables.rkt | 5 ++- pitfall/restructure/helper.rkt | 2 +- pitfall/restructure/struct.rkt | 4 +- 10 files changed, 11 insertions(+), 89 deletions(-) diff --git a/pitfall/fontkit/fpgm.rkt b/pitfall/fontkit/fpgm.rkt index 8cc17d99..ba6c8b82 100644 --- a/pitfall/fontkit/fpgm.rkt +++ b/pitfall/fontkit/fpgm.rkt @@ -19,7 +19,6 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/fpgm.js (test-module - (require racket/serialize) (define ip (open-input-file charter-path)) (define dir (deserialize (read (open-input-file charter-directory-path)))) (define offset (· dir tables fpgm offset)) diff --git a/pitfall/fontkit/helper.rkt b/pitfall/fontkit/helper.rkt index 15819f75..6617a066 100644 --- a/pitfall/fontkit/helper.rkt +++ b/pitfall/fontkit/helper.rkt @@ -11,5 +11,5 @@ (define-macro (test-module . EXPRS) #`(module+ test - (require #,(datum->syntax caller-stx 'rackunit)) + (require #,(datum->syntax caller-stx 'rackunit) #,(datum->syntax caller-stx 'racket/serialize)) . EXPRS)) \ No newline at end of file diff --git a/pitfall/fontkit/hhea.rkt b/pitfall/fontkit/hhea.rkt index 9e99f17a..510d50cd 100644 --- a/pitfall/fontkit/hhea.rkt +++ b/pitfall/fontkit/hhea.rkt @@ -23,7 +23,6 @@ ))) (test-module - (require racket/serialize) (define ip (open-input-file charter-path)) (define dir (deserialize (read (open-input-file charter-directory-path)))) (define offset (· dir tables hhea offset)) diff --git a/pitfall/fontkit/hmtx.rkt b/pitfall/fontkit/hmtx.rkt index 62de65d9..79e5f304 100644 --- a/pitfall/fontkit/hmtx.rkt +++ b/pitfall/fontkit/hmtx.rkt @@ -19,4 +19,5 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/hmtx.js 'bearing uint16be))) - +(test-module + ) \ No newline at end of file diff --git a/pitfall/fontkit/loca.rkt b/pitfall/fontkit/loca.rkt index 0b317623..1e920da9 100644 --- a/pitfall/fontkit/loca.rkt +++ b/pitfall/fontkit/loca.rkt @@ -43,7 +43,6 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/loca.js (test-module - (require racket/serialize) (define ip (open-input-file charter-path)) (define dir (deserialize (read (open-input-file charter-directory-path)))) (define offset (· dir tables loca offset)) diff --git a/pitfall/fontkit/maxp.rkt b/pitfall/fontkit/maxp.rkt index c3819434..03f2e68a 100644 --- a/pitfall/fontkit/maxp.rkt +++ b/pitfall/fontkit/maxp.rkt @@ -24,7 +24,6 @@ (test-module - (require racket/serialize) (define ip (open-input-file charter-path)) (define dir (deserialize (read (open-input-file charter-directory-path)))) (define maxp-offset (· dir tables maxp offset)) diff --git a/pitfall/fontkit/prep.rkt b/pitfall/fontkit/prep.rkt index f742aea1..553f907a 100644 --- a/pitfall/fontkit/prep.rkt +++ b/pitfall/fontkit/prep.rkt @@ -14,7 +14,6 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/prep.js (test-module - (require racket/serialize) (define ip (open-input-file charter-path)) (define dir (deserialize (read (open-input-file charter-directory-path)))) (define offset (· dir tables prep offset)) @@ -25,81 +24,4 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/prep.js (define table-bytes #"\270\0\0+\0\272\0\1\0\1\0\2+\1\272\0\2\0\1\0\2+\1\277\0\2\0C\0007\0+\0\37\0\23\0\0\0\b+\0\277\0\1\0\200\0i\0R\0;\0#\0\0\0\b+\0\272\0\3\0\5\0\a+\270\0\0 E}i\30D") (check-equal? table-bytes (peek-bytes len offset ip)) (define ds (+DecodeStream (peek-bytes len offset ip))) - (check-equal? (hash-ref (send prep decode ds) 'controlValueProgram) '(184 - 0 - 0 - 43 - 0 - 186 - 0 - 1 - 0 - 1 - 0 - 2 - 43 - 1 - 186 - 0 - 2 - 0 - 1 - 0 - 2 - 43 - 1 - 191 - 0 - 2 - 0 - 67 - 0 - 55 - 0 - 43 - 0 - 31 - 0 - 19 - 0 - 0 - 0 - 8 - 43 - 0 - 191 - 0 - 1 - 0 - 128 - 0 - 105 - 0 - 82 - 0 - 59 - 0 - 35 - 0 - 0 - 0 - 8 - 43 - 0 - 186 - 0 - 3 - 0 - 5 - 0 - 7 - 43 - 184 - 0 - 0 - 32 - 69 - 125 - 105 - 24 - 68))) + (check-equal? (hash-ref (send prep decode ds) 'controlValueProgram) '(184 0 0 43 0 186 0 1 0 1 0 2 43 1 186 0 2 0 1 0 2 43 1 191 0 2 0 67 0 55 0 43 0 31 0 19 0 0 0 8 43 0 191 0 1 0 128 0 105 0 82 0 59 0 35 0 0 0 8 43 0 186 0 3 0 5 0 7 43 184 0 0 32 69 125 105 24 68))) diff --git a/pitfall/fontkit/tables.rkt b/pitfall/fontkit/tables.rkt index 92ef8eab..c4dbc63e 100644 --- a/pitfall/fontkit/tables.rkt +++ b/pitfall/fontkit/tables.rkt @@ -2,10 +2,11 @@ (provide (all-defined-out)) (define-macro (define-table-decoders ID TABLE-ID ...) - (with-pattern ([TABLE-ID-STRINGS (pattern-case-filter #'(TABLE-ID ...) + (with-pattern ([(TABLE-ID-STRING ...) (pattern-case-filter #'(TABLE-ID ...) [STX (datum->syntax caller-stx (format "~a.rkt" (syntax->datum #'STX)))])]) #'(begin - (r+p . TABLE-ID-STRINGS) + (r+p TABLE-ID-STRING ...) + (test-module (require (submod TABLE-ID-STRING test) ...)) (define ID (make-hasheq (map cons (list 'TABLE-ID ...) (list TABLE-ID ...))))))) (define-table-decoders table-decoders maxp hhea head loca prep fpgm hmtx) \ No newline at end of file diff --git a/pitfall/restructure/helper.rkt b/pitfall/restructure/helper.rkt index aff744ac..360a76fa 100644 --- a/pitfall/restructure/helper.rkt +++ b/pitfall/restructure/helper.rkt @@ -16,7 +16,7 @@ (define-macro (test-module . EXPRS) #`(module+ test - (require #,(datum->syntax caller-stx 'rackunit)) + (require #,(datum->syntax caller-stx 'rackunit) #,(datum->syntax caller-stx 'racket/serialize)) . EXPRS)) (define index? (λ (x) (and (number? x) (integer? x) (not (negative? x))))) \ No newline at end of file diff --git a/pitfall/restructure/struct.rkt b/pitfall/restructure/struct.rkt index 7758decd..1f2289f5 100644 --- a/pitfall/restructure/struct.rkt +++ b/pitfall/restructure/struct.rkt @@ -23,12 +23,14 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee (define/augride (encode stream input-hash [parent #f]) (unless (hash? input-hash) (raise-argument-error 'Struct:encode "hash" input-hash)) + + (send this preEncode input-hash stream) ; might bring input hash into compliance + (define sorted-input-keys (sort (hash-keys input-hash) #:key symbol->string stringstring string