testability

quad/qtest/all.rkt

@@ -0,0 +1,32 @@
+#lang racket
+(require quadwriter pitfall/check-pdf racket/runtime-path)
+
+(define-for-syntax (test-pdf-name path)
+  (path-add-extension (path-replace-extension path #".pdf") #"" #" copy."))
+
+(define-syntax (make-test-pdf stx)
+  (syntax-case stx ()
+    [(_ PATH)
+     (with-syntax ([PDF-NAME (test-pdf-name (syntax-e #'PATH))])
+       #'(parameterize ([quadwriter-test-mode #t])
+           (render-pdf (dynamic-require PATH 'doc) PDF-NAME)))]))
+
+(define-syntax (test-one stx)
+  (syntax-case stx ()
+    [(_ PATH)
+     (with-syntax ([PDF-NAME (test-pdf-name (syntax-e #'PATH))])
+       #'(begin
+           (define-runtime-path path-to-test PATH)
+           (define-runtime-path test-base PDF-NAME)
+           (println PATH)
+           (check-pdfs-equal? (time (parameterize ([quadwriter-test-mode #t]
+                                                   [current-output-port (open-output-nowhere)])
+                                      (render-pdf (dynamic-require path-to-test 'doc) #f))) test-base)))]))
+
+(define-syntax-rule (test-each PATH ...)
+  (begin (test-one PATH) ...))
+
+(test-each "hello.rkt"
+           "hello.rkt"
+           "hello.rkt")
+

quad/qtest/hello.rkt

@@ -1,3 +1,3 @@
-#lang qtest/typewriter 1
+#lang quadwriter/markdown
 
 Hello world

quad/quadwriter/core.rkt

@@ -1,6 +1,7 @@
 #lang debug racket/base
 (require "layout.rkt"
-         "render.rkt")
+         "render.rkt"
+         "param.rkt")
 (provide render-pdf
          para-break
          line-break
@@ -9,5 +10,6 @@
          bullet-quad
          hrbr
          lbr
-         pbr)
+         pbr
+         (all-from-out "param.rkt"))
 

quad/quadwriter/layout.rkt

@@ -458,8 +458,9 @@
                     #:printable #true
                     #:draw-start (λ (q doc)
                                    (when draw-debug-line?
-                                     (draw-debug q doc "goldenrod" "goldenrod")) 
-                                   (draw-page-footer q doc))))
+                                     (draw-debug q doc "goldenrod" "goldenrod"))
+                                   (unless (quadwriter-test-mode)
+                                     (draw-page-footer q doc)))))
 
 (define q:column (q
                   #:id 'col

quad/quadwriter/param.rkt

@@ -11,6 +11,7 @@
          (define current-pdf (make-parameter #false))
          (define current-locale (make-parameter 'us))
          (define current-line-wrap (make-parameter #f)) ; because kp is slow and maybe we want to disable for "draft" mode
+         (define quadwriter-test-mode (make-parameter #f)) ; used during rackunit to suppress nondeterministic elements, like timestamp in header
 
          (define draw-debug? (make-parameter #t))
          (define draw-debug-line? (make-parameter #true))
@@ -31,6 +32,7 @@
          (define current-pdf (make-parameter #false))
          (define current-locale (make-parameter 'us))
          (define current-line-wrap (make-parameter #f))
+         (define quadwriter-test-mode (make-parameter #f))
 
          (define draw-debug? (make-parameter #false))
          (define draw-debug-line? (make-parameter #true))

quad/quadwriter/render.rkt

@@ -57,7 +57,7 @@
   [define indented-qs (insert-first-line-indents stringified-qs)]
   indented-qs)
 
-(define (setup-pdf qs pdf-path)
+(define (setup-pdf qs pdf-path compress?)
   ;; page size can be specified by name, or measurements.
   ;; explicit measurements from page-height and page-width supersede those from page-size.
   (match-define (list page-width page-height) (for/list ([k (list :page-width :page-height)])
@@ -65,7 +65,7 @@
                                                   [#false #false]
                                                   [val (parse-dimension val 'round)])))
   ;; `make-pdf` will sort out conflicts among page dimensions
-  (make-pdf #:compress #true
+  (make-pdf #:compress compress?
             #:auto-first-page #false
             #:output-path pdf-path
             #:width (or (debug-page-width) page-width)
@@ -109,8 +109,11 @@
   (or (debug-column-gap) (quad-ref (car qs) :column-gap default-column-gap)))
 
 
-(define/contract (render-pdf qx-arg pdf-path-arg #:replace [replace? #t])
-  ((qexpr? (or/c #false path? path-string?)) (#:replace any/c) . ->* . (or/c void? bytes?))
+(define/contract (render-pdf qx-arg pdf-path-arg
+                             #:replace [replace? #t]
+                             #:compress [compress? #t])
+  ((qexpr? (or/c #false path? path-string?)) (#:replace any/c
+                                              #:compress any/c) . ->* . (or/c void? bytes?))
 
   (define pdf-path (setup-pdf-path pdf-path-arg))
   (when (and (not replace?) (file-exists? pdf-path))
@@ -118,7 +121,7 @@
   
   (define qs (setup-qs qx-arg pdf-path))
 
-  (parameterize ([current-pdf (setup-pdf qs pdf-path)]
+  (parameterize ([current-pdf (setup-pdf qs pdf-path compress?)]
                  [verbose-quad-printing? #false])
     (match-define (list left-margin top-margin right-margin bottom-margin) (setup-margins qs (current-pdf)))
     (define printable-width (- (pdf-width (current-pdf)) left-margin right-margin))