From 771c94fb692fdd19cdffc03201e0c3cc81c7c087 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 27 May 2019 08:32:35 -0700 Subject: [PATCH] testability --- quad/qtest/all.rkt | 32 ++++++++++++++++++++++++++++++++ quad/qtest/hello.rkt | 2 +- quad/quadwriter/core.rkt | 6 ++++-- quad/quadwriter/layout.rkt | 5 +++-- quad/quadwriter/param.rkt | 2 ++ quad/quadwriter/render.rkt | 13 ++++++++----- 6 files changed, 50 insertions(+), 10 deletions(-) create mode 100644 quad/qtest/all.rkt diff --git a/quad/qtest/all.rkt b/quad/qtest/all.rkt new file mode 100644 index 00000000..745fa962 --- /dev/null +++ b/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") + diff --git a/quad/qtest/hello.rkt b/quad/qtest/hello.rkt index 37893e93..b1c65a50 100644 --- a/quad/qtest/hello.rkt +++ b/quad/qtest/hello.rkt @@ -1,3 +1,3 @@ -#lang qtest/typewriter 1 +#lang quadwriter/markdown Hello world \ No newline at end of file diff --git a/quad/quadwriter/core.rkt b/quad/quadwriter/core.rkt index b039e3a5..47ae36e7 100644 --- a/quad/quadwriter/core.rkt +++ b/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")) diff --git a/quad/quadwriter/layout.rkt b/quad/quadwriter/layout.rkt index 3545c4fa..752816f7 100644 --- a/quad/quadwriter/layout.rkt +++ b/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 diff --git a/quad/quadwriter/param.rkt b/quad/quadwriter/param.rkt index 6fff02f1..2ea83087 100644 --- a/quad/quadwriter/param.rkt +++ b/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)) diff --git a/quad/quadwriter/render.rkt b/quad/quadwriter/render.rkt index d7ba6ac3..36c426db 100644 --- a/quad/quadwriter/render.rkt +++ b/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))