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

raco setup: send Scribble debug into to log as well as verbose

Browse Source
This commit is contained in:
Matthew Flatt 2013-07-17 12:07:00 -06:00
parent f90b678a71
commit 34880bd154
1 changed files with 38 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

75
pkgs/racket-pkgs/racket-index/setup/scribble.rkt
View File

@ -40,6 +40,13 @@
(define-logger setup) (define-logger setup)
(define-syntax-rule (verbose/log format-str arg ...)
(begin
(when (verbose)
(printf (string-append " [" format-str "]\n")
arg ...))
(log-setup-debug format-str arg ...)))
(define-serializable-struct doc (src-dir (define-serializable-struct doc (src-dir
src-spec src-spec
src-file src-file
@ -426,10 +433,10 @@
(doc-under-main? (info-doc d)) (doc-under-main? (info-doc d))
all-main?)) all-main?))
(set! added? #t) (set! added? #t)
(when (verbose) (verbose/log
(printf " [Removed Dependency for ~a: ~a]\n" (printf "Removed Dependency for ~a: ~a"
(doc-name (info-doc info)) (doc-name (info-doc info))
(doc-name (info-doc info)))))))) (doc-name (info-doc info))))))))
(define (add-dependency info i) (define (add-dependency info i)
(cond (cond
[((info-start-time info) . < . (info-done-time info)) [((info-start-time info) . < . (info-done-time info))
@ -437,27 +444,24 @@
;; the build actually happened after the dependency's "out.sxref" ;; the build actually happened after the dependency's "out.sxref"
;; files were written, so they would have been used. ;; files were written, so they would have been used.
;; Fix up the dependency list. ;; Fix up the dependency list.
(when (verbose) (verbose/log "Quick-add for ~a: ~a"
(printf " [Quick-add for ~a: ~a]\n" (doc-name (info-doc info))
(doc-name (info-doc info)) (doc-name (info-doc i)))
(doc-name (info-doc i))))
(hash-set! deps i #t) (hash-set! deps i #t)
(set-info-deps! info (cons (cons i (info-out-hash i)) (set-info-deps! info (cons (cons i (info-out-hash i))
(info-deps info))) (info-deps info)))
(set-info-need-in-write?! info #t)] (set-info-need-in-write?! info #t)]
[else [else
(when (verbose) (verbose/log "Adding for ~a: ~a"
(printf " [Adding for ~a: ~a]\n" (doc-name (info-doc info))
(doc-name (info-doc info)) (doc-name (info-doc i)))
(doc-name (info-doc i))))
(set! added? #t) (set! added? #t)
(hash-set! deps i #t)])) (hash-set! deps i #t)]))
;; Add expected dependencies for an "all dependencies" doc: ;; Add expected dependencies for an "all dependencies" doc:
(when (or (memq 'depends-all (doc-flags (info-doc info))) all-main?) (when (or (memq 'depends-all (doc-flags (info-doc info))) all-main?)
(when (verbose) (verbose/log "Adding all~a as dependencies for ~a"
(printf " [Adding all~a as dependencies for ~a]\n" (if all-main? " main" "")
(if all-main? " main" "") (doc-name (info-doc info)))
(doc-name (info-doc info))))
(for ([i infos]) (for ([i infos])
(hash-set! known-deps i #t) (hash-set! known-deps i #t)
(when (and (not (eq? i info)) (when (and (not (eq? i info))
@ -508,9 +512,8 @@
(when (or (when (or
;; If we added anything (expected or known), then mark as needed to run: ;; If we added anything (expected or known), then mark as needed to run:
(and added? (and added?
(when (verbose) (verbose/log "Rerun, since added dependencies for ~a"
(printf " [Rerun, since added dependencies for ~a]\n" (doc-name (info-doc info))))
(doc-name (info-doc info)))))
;; If any dependency change, then mark as needed to run: ;; If any dependency change, then mark as needed to run:
(and (let ([ch (ormap (lambda (p) (and (let ([ch (ormap (lambda (p)
(define i2 (car p)) (define i2 (car p))
@ -526,12 +529,11 @@
i2))) i2)))
(info-deps info))]) (info-deps info))])
(and ch (and ch
(when (verbose) (verbose/log "Rerun, since dependency changed for ~a: ~a"
(printf " [Rerun, since dependency changed for ~a: ~a]\n" (doc-name (info-doc info))
(doc-name (info-doc info)) (if (info? ch)
(if (info? ch) (doc-name (info-doc ch))
(doc-name (info-doc ch)) ch))))))
ch)))))))
(define (key->dep i v) (cons i (info-out-hash i))) (define (key->dep i v) (cons i (info-out-hash i)))
(set-info-deps! info (hash-map known-deps key->dep)) (set-info-deps! info (hash-map known-deps key->dep))
(set-info-need-in-write?! info #t) (set-info-need-in-write?! info #t)
@ -934,8 +936,8 @@
(when (or (and (not up-to-date?) (not only-fast?)) (when (or (and (not up-to-date?) (not only-fast?))
(verbose)) (verbose))
(when (and (verbose) out-of-date) (when out-of-date
(printf " [Need run (~a) ~a]\n" out-of-date (doc-name doc))) (verbose/log "Need run (~a) ~a" out-of-date (doc-name doc)))
(setup-printf (setup-printf
(string-append (string-append
(if workerid (format "~a " workerid) "") (if workerid (format "~a " workerid) "")
@ -1032,8 +1034,8 @@
'content) 'content)
(and (not provides-time) 'db-missing) (and (not provides-time) 'db-missing)
(and (info-out-time . > . provides-time) 'db-older))]) (and (info-out-time . > . provides-time) 'db-older))])
(when (and (verbose) need-out-write) (when need-out-write
(printf " [New out (~a) ~a]\n" need-out-write (doc-name doc))) (verbose/log "New out (~a) ~a" need-out-write (doc-name doc)))
(gc-point) (gc-point)
(let ([info (let ([info
(make-info doc (make-info doc
@ -1249,13 +1251,12 @@
[ff-sci ff-scis]) [ff-sci ff-scis])
(serialized=? sci ff-sci)))] (serialized=? sci ff-sci)))]
[db-file (find-db-file doc latex-dest)]) [db-file (find-db-file doc latex-dest)])
(when (verbose) (verbose/log "~a~afor ~a"
(printf " [~a~afor ~a]\n" (if in-delta? "New in " "")
(if in-delta? "New in " "") (cond [out-delta? "New out "]
(cond [out-delta? "New out "] [in-delta? ""]
[in-delta? ""] [else "No change "])
[else "No change "]) (doc-name doc))
(doc-name doc)))
(when (or in-delta? (when (or in-delta?
(and info (info-need-in-write? info)) (and info (info-need-in-write? info))
@ -1325,7 +1326,7 @@
(define (write- latex-dest vers doc name datas prep! final!) (define (write- latex-dest vers doc name datas prep! final!)
(let* ([filename (sxref-path latex-dest doc name)]) (let* ([filename (sxref-path latex-dest doc name)])
(prep! filename) (prep! filename)
(when (verbose) (printf " [Caching to disk ~a]\n" filename)) (verbose/log "Caching to disk ~a" filename)
(make-directory* (doc-dest-dir doc)) (make-directory* (doc-dest-dir doc))
(with-compile-output (with-compile-output
filename filename