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 (define-struct info (doc sci provides undef searches deps
build? time out-time need-run? build? time out-time need-run?
need-in-write? need-out-write? need-in-write? need-out-write?
vers rendered?) vers rendered? failed?)
#:mutable) #:mutable)
(define (user-doc? doc) (define (user-doc? doc)
@ -53,7 +53,8 @@
(define (setup-scribblings only-dirs ; limits doc builds (define (setup-scribblings only-dirs ; limits doc builds
latex-dest ; if not #f, generate Latex output 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))] (let* ([dirs (find-relevant-directories '(scribblings))]
[infos (map get-info/full dirs)] [infos (map get-info/full dirs)]
[docs (map (lambda (i dir) [docs (map (lambda (i dir)
@ -118,10 +119,14 @@
(ormap (can-build? only-dirs) (ormap (can-build? only-dirs)
(filter (lambda (doc) (not (doc-under-main? doc))) (filter (lambda (doc) (not (doc-under-main? doc)))
docs)))] 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))]) docs))])
(let loop ([first? #t] [iter 0]) (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 ;; Collect definitions
(for* ([info infos] (for* ([info infos]
[k (info-provides info)]) [k (info-provides info)])
@ -226,7 +231,7 @@
;; Build again, using dependencies ;; Build again, using dependencies
(for ([i infos] #:when (info-need-run? i)) (for ([i infos] #:when (info-need-run? i))
(set-info-need-run?! i #f) (set-info-need-run?! i #f)
(build-again! latex-dest i)) (build-again! latex-dest i with-record-error))
(loop #f (add1 iter))))) (loop #f (add1 iter)))))
;; cache info to disk ;; cache info to disk
(unless latex-dest (unless latex-dest
@ -296,7 +301,7 @@
(and (pair? cat) (and (pair? cat)
(eq? (car cat) 'omit)))) (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")] (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")] [info-in-file (build-path (or latex-dest (doc-dest-dir doc)) "in.sxref")]
[out-file (build-path (doc-dest-dir doc) "index.html")] [out-file (build-path (doc-dest-dir doc) "index.html")]
@ -344,7 +349,8 @@
(fprintf (current-error-port) "~a\n" (exn-message exn)) (fprintf (current-error-port) "~a\n" (exn-message exn))
(delete-file info-out-file) (delete-file info-out-file)
(delete-file info-in-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)] (let* ([v-in (with-input-from-file info-in-file read)]
[v-out (with-input-from-file info-out-file read)]) [v-out (with-input-from-file info-out-file read)])
(unless (and (equal? (car v-in) (list vers (doc-flags doc))) (unless (and (equal? (car v-in) (list vers (doc-flags doc)))
@ -362,9 +368,13 @@
(memq 'always-run (doc-flags doc))) (memq 'always-run (doc-flags doc)))
#f #f #f #f
vers vers
#f
#f))) #f)))
(if can-run? (if can-run?
;; Run the doc once: ;; Run the doc once:
(with-record-error
(doc-src-file doc)
(lambda ()
(parameterize ([current-directory (doc-src-dir doc)]) (parameterize ([current-directory (doc-src-dir doc)])
(let* ([v (ensure-doc-prefix (dynamic-require-doc (doc-src-file doc)) (let* ([v (ensure-doc-prefix (dynamic-require-doc (doc-src-file doc))
(doc-src-file doc))] (doc-src-file doc))]
@ -401,16 +411,21 @@
#t #t
can-run? need-out-write? can-run? need-out-write?
vers vers
#f))) #f
#f))))
(lambda () #f))
#f)))) #f))))
(define (build-again! latex-dest info) (define (build-again! latex-dest info with-record-error)
(let* ([doc (info-doc info)] (let* ([doc (info-doc info)]
[renderer (make-renderer latex-dest doc)]) [renderer (make-renderer latex-dest doc)])
(printf " [R~aendering ~a]\n" (printf " [R~aendering ~a]\n"
(if (info-rendered? info) "e-r" "") (if (info-rendered? info) "e-r" "")
(doc-src-file doc)) (doc-src-file doc))
(set-info-rendered?! info #t) (set-info-rendered?! info #t)
(with-record-error
(doc-src-file doc)
(lambda ()
(parameterize ([current-directory (doc-src-dir doc)]) (parameterize ([current-directory (doc-src-dir doc)])
(let* ([v (ensure-doc-prefix (dynamic-require-doc (doc-src-file doc)) (let* ([v (ensure-doc-prefix (dynamic-require-doc (doc-src-file doc))
(doc-src-file doc))] (doc-src-file doc))]
@ -449,10 +464,16 @@
(for ([f (directory-list dir)] (for ([f (directory-list dir)]
#:when (regexp-match? #"[.]html$" (path-element->bytes f))) #:when (regexp-match? #"[.]html$" (path-element->bytes f)))
(delete-file (build-path dir 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)) (set-info-time! info (/ (current-inexact-milliseconds) 1000))
(gc-point) (gc-point)
(void)))))) (void)))))
(lambda ()
(set-info-failed?! info #t)))))
(define (gc-point) (define (gc-point)
;; Forcing a GC on document boundaries helps keep peak memory use down. ;; 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 errors null)
(define (record-error cc desc go) (define (record-error cc desc go fail-k)
(with-handlers ([exn:fail? (with-handlers ([exn:fail?
(lambda (x) (lambda (x)
(if (exn? x) (if (exn? x)
(fprintf (current-error-port) "~a\n" (exn-message x)) (fprintf (current-error-port) "~a\n" (exn-message x))
(fprintf (current-error-port) "~s\n" 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))) (go)))
(define-syntax begin-record-error (define-syntax begin-record-error
(syntax-rules () (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) (define (show-errors port)
(for ([e (reverse errors)]) (for ([e (reverse errors)])
(let ([cc (car e)] (let ([cc (car e)]
[desc (cadr e)] [desc (cadr e)]
[x (caddr e)]) [x (caddr e)])
(setup-fprintf port "Error during ~a for ~a (~a)" (setup-fprintf port "Error during ~a for ~a"
desc (cc-name cc) (path->string (cc-path cc))) desc
(if (cc? cc)
(format "~a (~a)" (cc-name cc) (path->string (cc-path cc)))
cc))
(if (exn? x) (if (exn? x)
(setup-fprintf port " ~a" (exn-message x)) (setup-fprintf port " ~a" (exn-message x))
(setup-fprintf port " ~s" x))))) (setup-fprintf port " ~s" x)))))
@ -755,7 +759,11 @@
((doc:setup-scribblings) ((doc:setup-scribblings)
(if no-specific-collections? #f (map cc-path ccs-to-compile)) (if no-specific-collections? #f (map cc-path ccs-to-compile))
#f #f
(not (null? (archives)))))) (not (null? (archives)))
(lambda (what go alt)
(record-error what "Building docs"
go
alt)))))
(define (render-pdf file) (define (render-pdf file)
(define cmd (define cmd