suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

better handling of doc-build failures

Browse Source 
svn: r8504
This commit is contained in:
Matthew Flatt 2008-02-02 13:20:03 +00:00
parent 36aa1bd3f2
commit 3260e8f34a
2 changed files with 123 additions and 94 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
collects/setup/scribble.ss
View File

@ -21,7 +21,7 @@
(define-struct info (doc sci provides undef searches deps
build? time out-time need-run?
need-in-write? need-out-write?
vers rendered?)
vers rendered? failed?)
#:mutable)
(define (user-doc? doc)
@ -53,7 +53,8 @@
(define (setup-scribblings only-dirs ; limits doc builds
latex-dest ; if not #f, generate Latex output
auto-start-doc?) ; if #t, expands `only-dir' with [user-]start to catch new docs
auto-start-doc? ; if #t, expands `only-dir' with [user-]start to catch new docs
with-record-error) ; catch & record exceptions
(let* ([dirs (find-relevant-directories '(scribblings))]
[infos (map get-info/full dirs)]
[docs (map (lambda (i dir)
@ -118,10 +119,14 @@
(ormap (can-build? only-dirs)
(filter (lambda (doc) (not (doc-under-main? doc)))
docs)))]
[infos (filter values (map (get-doc-info only-dirs latex-dest auto-main? auto-user?)
[infos (filter values (map (get-doc-info only-dirs latex-dest
auto-main? auto-user? with-record-error)
docs))])
(let loop ([first? #t] [iter 0])
(let ([ht (make-hash-table 'equal)])
(let ([ht (make-hash-table 'equal)]
[infos (filter (lambda (i)
(not (info-failed? i)))
infos)])
;; Collect definitions
(for* ([info infos]
[k (info-provides info)])
@ -226,7 +231,7 @@
;; Build again, using dependencies
(for ([i infos] #:when (info-need-run? i))
(set-info-need-run?! i #f)
(build-again! latex-dest i))
(build-again! latex-dest i with-record-error))
(loop #f (add1 iter)))))
;; cache info to disk
(unless latex-dest
@ -296,7 +301,7 @@
(and (pair? cat)
(eq? (car cat) 'omit))))
(define ((get-doc-info only-dirs latex-dest auto-main? auto-user?) doc)
(define ((get-doc-info only-dirs latex-dest auto-main? auto-user? with-record-error) doc)
(let* ([info-out-file (build-path (or latex-dest (doc-dest-dir doc)) "out.sxref")]
[info-in-file (build-path (or latex-dest (doc-dest-dir doc)) "in.sxref")]
[out-file (build-path (doc-dest-dir doc) "index.html")]
@ -344,7 +349,8 @@
(fprintf (current-error-port) "~a\n" (exn-message exn))
(delete-file info-out-file)
(delete-file info-in-file)
((get-doc-info only-dirs latex-dest auto-main? auto-user?) doc))])
((get-doc-info only-dirs latex-dest auto-main? auto-user?
with-record-error) doc))])
(let* ([v-in (with-input-from-file info-in-file read)]
[v-out (with-input-from-file info-out-file read)])
(unless (and (equal? (car v-in) (list vers (doc-flags doc)))
@ -362,9 +368,13 @@
(memq 'always-run (doc-flags doc)))
#f #f
vers
#f
#f)))
(if can-run?
;; Run the doc once:
(with-record-error
(doc-src-file doc)
(lambda ()
(parameterize ([current-directory (doc-src-dir doc)])
(let* ([v (ensure-doc-prefix (dynamic-require-doc (doc-src-file doc))
(doc-src-file doc))]
@ -401,16 +411,21 @@
#t
can-run? need-out-write?
vers
#f)))
#f
#f))))
(lambda () #f))
#f))))
(define (build-again! latex-dest info)
(define (build-again! latex-dest info with-record-error)
(let* ([doc (info-doc info)]
[renderer (make-renderer latex-dest doc)])
(printf " [R~aendering ~a]\n"
(if (info-rendered? info) "e-r" "")
(doc-src-file doc))
(set-info-rendered?! info #t)
(with-record-error
(doc-src-file doc)
(lambda ()
(parameterize ([current-directory (doc-src-dir doc)])
(let* ([v (ensure-doc-prefix (dynamic-require-doc (doc-src-file doc))
(doc-src-file doc))]
@ -449,10 +464,16 @@
(for ([f (directory-list dir)]
#:when (regexp-match? #"[.]html$" (path-element->bytes f)))
(delete-file (build-path dir f)))))
(send renderer render (list v) (list dest-dir) ri)
(with-record-error
(doc-src-file doc)
(lambda ()
(send renderer render (list v) (list dest-dir) ri))
void)
(set-info-time! info (/ (current-inexact-milliseconds) 1000))
(gc-point)
(void))))))
(void)))))
(lambda ()
(set-info-failed?! info #t)))))
(define (gc-point)
;; Forcing a GC on document boundaries helps keep peak memory use down.

20
collects/setup/setup-unit.ss
View File

@ -70,24 +70,28 @@
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define errors null)
(define (record-error cc desc go)
(define (record-error cc desc go fail-k)
(with-handlers ([exn:fail?
(lambda (x)
(if (exn? x)
(fprintf (current-error-port) "~a\n" (exn-message x))
(fprintf (current-error-port) "~s\n" x))
(set! errors (cons (list cc desc x) errors)))])
(set! errors (cons (list cc desc x) errors))
(fail-k))])
(go)))
(define-syntax begin-record-error
(syntax-rules ()
[(_ cc desc body ...) (record-error cc desc (lambda () body ...))]))
[(_ cc desc body ...) (record-error cc desc (lambda () body ...) void)]))
(define (show-errors port)
(for ([e (reverse errors)])
(let ([cc (car e)]
[desc (cadr e)]
[x (caddr e)])
(setup-fprintf port "Error during ~a for ~a (~a)"
desc (cc-name cc) (path->string (cc-path cc)))
(setup-fprintf port "Error during ~a for ~a"
desc
(if (cc? cc)
(format "~a (~a)" (cc-name cc) (path->string (cc-path cc)))
cc))
(if (exn? x)
(setup-fprintf port " ~a" (exn-message x))
(setup-fprintf port " ~s" x)))))
@ -755,7 +759,11 @@
((doc:setup-scribblings)
(if no-specific-collections? #f (map cc-path ccs-to-compile))
#f
(not (null? (archives))))))
(not (null? (archives)))
(lambda (what go alt)
(record-error what "Building docs"
go
alt)))))
(define (render-pdf file)
(define cmd