changed the fonts used under linux for the bitmap test cases

svn: r17855

collects/redex/tests/bitmap-test-util.ss

@@ -20,12 +20,13 @@
     [(_ test-exp bitmap-filename)
      #`(test/proc
         #,(syntax-line stx)
-        test-exp
+        (λ () test-exp)
         bitmap-filename)]))
 
-(define (test/proc line-number pict raw-bitmap-filename)
+(define (test/proc line-number pict-thunk raw-bitmap-filename)
   (set! tests (+ tests 1))
-  (let* ([bitmap-filename 
+  (let* ([pict (set-fonts/call pict-thunk)]
+         [bitmap-filename 
           (build-path (format "bmps-~a" (system-type))
                       raw-bitmap-filename)]
          [old-bitmap (if (file-exists? bitmap-filename)
@@ -48,6 +49,33 @@
         (let ([failed-panel (make-failed-panel line-number bitmap-filename old-bitmap new-bitmap diff-bitmap)])
           (set! failed (append failed (list failed-panel))))))))
 
+(define (set-fonts/call thunk)
+  (case (system-type)
+    [(unix)
+     (let ([rewrite-style 
+            (λ (s)
+              (let loop ([s s])
+                (cond
+                  [(pair? s) (cons (loop (car s)) (loop (cdr s)))]
+                  [(eq? s 'roman) (verify-face " DejaVu Serif")]
+                  [(eq? s 'swiss) (verify-face " DejaVu Sans")]
+                  [else s])))])
+       (parameterize ([label-style (rewrite-style (label-style))]
+                      [literal-style (rewrite-style (literal-style))]
+                      [metafunction-style (rewrite-style (metafunction-style))]
+                      [non-terminal-style (rewrite-style (non-terminal-style))]
+                      [non-terminal-subscript-style (rewrite-style (non-terminal-subscript-style))]
+                      [non-terminal-superscript-style (rewrite-style (non-terminal-superscript-style))]
+                      [default-style (rewrite-style (default-style))])
+         (thunk)))]
+    [else
+     (thunk)]))
+
+(define (verify-face face)
+  (unless (member face (get-face-list))
+    (error 'verify-face "unknown face: ~s" face))
+  face)
+  
 (define (compute-diffs old-bitmap new-bitmap)
   (let* ([w (max (send old-bitmap get-width)
                  (send new-bitmap get-width))]