testier

pitfall/pitfall/check-pdf.rkt

@@ -1,5 +1,5 @@
 #lang debug racket
-(require rackunit (prefix-in zlib: pitfall/zlib))
+(require rackunit (prefix-in zlib: pitfall/zlib) fontland/table/cff/cff-top)
 (provide (all-defined-out))
 
 (define (xref-offset bs)
@@ -140,6 +140,37 @@
 (define-simple-check (check-pdfs-equal? ps1 ps2)
   (dict-compare ps1 ps2))
 
+(define-simple-check (check-font-subsets-equal? f1 f2)
+  (define misses null)
+
+  (define (dump val)
+    (cond
+      [(promise? val) 'promise-omitted]
+      [(dict? val)
+       (for/list ([(k v) (in-dict (sort (dict->list val) #:key car symbol<?))])
+                 (list k (dump v)))]
+      [(list? val) (map dump val)]
+      [else val]))
+
+  (define (cmp v1 v2)
+    (cond
+      [(and (list? v1) (list? v2))
+       (and
+        (= (length v1) (length v2))
+        (for/and ([x1 (in-list v1)]
+                  [x2 (in-list v2)])
+                 (unless (cmp x1 x2)
+                   (set! misses (cons (list v1 x1 v2 x2) misses)))))]
+      [else (equal? v1 v2)]))
+
+  (define ibs1 (dict-ref (dict-ref (pdf->dict f1) 8) 'stream))
+  (define cfftop1 (dump (send CFFTop decode (open-input-bytes ibs1))))
+  (define ibs2 (dict-ref (dict-ref (pdf->dict f2) 8) 'stream))
+  (define cfftop2 (dump (send CFFTop decode (open-input-bytes ibs2))))
+
+  (cmp cfftop1 cfftop2)
+  (check-true (null? misses)))
+
 #;(module+ main
     (for ([p (in-directory)]
           #:when (path-has-extension? p #"pdf"))

pitfall/pitfall/pdftest.rkt

@@ -7,7 +7,7 @@
   br/define
   "check-pdf.rkt")
 
-(provide check-copy-equal? check-pdfkit? make-doc)
+(provide check-copy-equal? check-pdfkit? make-doc check-font-subsets-equal?)
 
 (test-mode #t)
 

pitfall/ptest/alltest.rkt

@@ -1,5 +1,5 @@
 #lang racket
-(for ([i (in-range 20)])
+(for ([i (in-range 22)])
   (define which (string->symbol (format "ptest/test~a" i)))
   (println which)
   (dynamic-require which #f))

pitfall/ptest/test20.rkt

@@ -23,3 +23,6 @@
 
 (define-runtime-path that "test20crkt.pdf")
 (make-doc that #t proc)
+
+(check-font-subsets-equal? "test20rkt.pdf" "test20.pdf")
+

pitfall/ptest/test21.rkt

@@ -13,13 +13,15 @@
   (register-font doc "charter" (path->string charter))
 
   ;; Set the font, draw some text
-  [font doc "fira"]
+  [font doc "charter"]
   [font-size doc 40]
-  [text doc "Fira OTF rifle fire" 100 100])
+  [text doc "Charter OTF rifle fire" 100 100])
 
 ;; test against non-subsetted font version
-(define-runtime-path this "test20rkt.pdf")
+(define-runtime-path this "test21rkt.pdf")
 (make-doc this #f proc)
 
-(define-runtime-path that "test20crkt.pdf")
+(define-runtime-path that "test21crkt.pdf")
 (make-doc that #t proc)
+
+(check-font-subsets-equal? "test21rkt.pdf" "test21.pdf")