From 44afa3cb6685fc71d9316197e6d23583cfd28755 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 12 Jul 2013 14:50:49 -0600 Subject: [PATCH] raco setup: track document dependencies based on SHA1s Use SHA1s instead of timestamps for detecting dependency changes, which works with pre-built documentation. (The problem with timestamps didn't come up before because dependency checking was broken.) --- .../racket-doc/scribblings/guide/info.rkt | 2 +- .../racket-doc/scribblings/raco/setup.scrbl | 34 +- .../racket-doc/scribblings/reference/info.rkt | 2 +- .../racket-index/scribblings/main/info.rkt | 4 +- .../racket-index/setup/scribble.rkt | 386 ++++++++++-------- racket/lib/collects/setup/setup-unit.rkt | 3 +- 6 files changed, 247 insertions(+), 184 deletions(-) diff --git a/pkgs/racket-pkgs/racket-doc/scribblings/guide/info.rkt b/pkgs/racket-pkgs/racket-doc/scribblings/guide/info.rkt index 5b4c5de676..b1cb1aa2b9 100644 --- a/pkgs/racket-pkgs/racket-doc/scribblings/guide/info.rkt +++ b/pkgs/racket-pkgs/racket-doc/scribblings/guide/info.rkt @@ -1,5 +1,5 @@ #lang info -(define scribblings '(("guide.scrbl" (multi-page) (racket-core -11)))) +(define scribblings '(("guide.scrbl" (multi-page) (racket-core -11) "guide" 1 -9))) (define compile-omit-paths '("contracts-examples")) diff --git a/pkgs/racket-pkgs/racket-doc/scribblings/raco/setup.scrbl b/pkgs/racket-pkgs/racket-doc/scribblings/raco/setup.scrbl index f20b6325d8..f69c1ea0d5 100644 --- a/pkgs/racket-pkgs/racket-doc/scribblings/raco/setup.scrbl +++ b/pkgs/racket-pkgs/racket-doc/scribblings/raco/setup.scrbl @@ -291,20 +291,30 @@ Optional @filepath{info.rkt} fields trigger additional actions by [doc (list src-string) (list src-string flags) (list src-string flags category) - (list src-string flags category name-string) - (list src-string flags category name-string out-k)] + (list src-string flags category name) + (list src-string flags category name out-k) + (list src-string flags category name out-k order-n)] [flags (list mode-symbol ...)] [category (list category-symbol) (list category-symbol sort-number)] + [name string + #f] ] A document's list optionally continues with information on how to - build the document. If a document's list contains a second item, it - must be a list of mode symbols (described below). If a document's - list contains a third item, it must be a list that categorizes the - document (described further below). If a document's list contains a - fourth item, it is a name to use for the generated documentation, - instead of defaulting to the source file's name (sans extension). + build the document. If a document's list contains a second item, + @racket[_flags], it must be a list of mode symbols (described + below). If a document's list contains a third item, + @racket[_category], it must be a list that categorizes the document + (described further below). If a document's list contains a fourth + item, @racket[_name], it is a name to use for the generated + documentation, instead of defaulting to the source file's name + (sans extension), where @racket[#f] means to use the default. If a + document's list contains a fifth item, @racket[_out-k], it is used + a hint for the number of files to use for the document's + cross-reference information; see below. If a document's list + contains a fourth item, @racket[_order-n], it is used a hint for + the order of rendering; see below. Each mode symbol in @racket[_flags] can be one of the following, where only @racket['multi-page] is commonly used: @@ -415,7 +425,13 @@ Optional @filepath{info.rkt} fields trigger additional actions by document's cross-reference information into multiple parts, which can reduce the time and memory use for resolving a cross-reference into the document. It must be a positive, exact integer, and the - default is @racket[1].} + default is @racket[1]. + + The @racket[_order-n] specification is a hint for ordering document + builds, since documentation references can be mutually recursive. + The order hint can be any real number. The main Racket reference + is given a value of @racket[10], the search page is given a + value of @racket[-10], and the default is @racket[0].} @item{@as-index{@racketidfont{release-notes}} : @racket[(listof (cons/c string? (cons/c string? list?)))] --- A list of release-notes text files to link from the main documentation pages. diff --git a/pkgs/racket-pkgs/racket-doc/scribblings/reference/info.rkt b/pkgs/racket-pkgs/racket-doc/scribblings/reference/info.rkt index 07ebd32b06..8c61a8e41f 100644 --- a/pkgs/racket-pkgs/racket-doc/scribblings/reference/info.rkt +++ b/pkgs/racket-pkgs/racket-doc/scribblings/reference/info.rkt @@ -1,3 +1,3 @@ #lang info -(define scribblings '(("reference.scrbl" (multi-page) (racket-core -12) "reference" 16))) +(define scribblings '(("reference.scrbl" (multi-page) (racket-core -12) "reference" 16 -10))) diff --git a/pkgs/racket-pkgs/racket-index/scribblings/main/info.rkt b/pkgs/racket-pkgs/racket-index/scribblings/main/info.rkt index 437aecf69c..e1fd50aec2 100644 --- a/pkgs/racket-pkgs/racket-index/scribblings/main/info.rkt +++ b/pkgs/racket-pkgs/racket-index/scribblings/main/info.rkt @@ -3,8 +3,8 @@ (define scribblings '(("start.scrbl" (main-doc-root depends-all-main no-depend-on) (omit)) - ("search.scrbl" (depends-all-main no-depend-on) (omit)) - ("local-redirect.scrbl" (depends-all-main no-depend-on) (omit)) + ("search.scrbl" (depends-all-main no-depend-on) (omit) "search" 1 10) + ("local-redirect.scrbl" (depends-all-main no-depend-on) (omit) "local-redirect" 1 10) ("license.scrbl" () (omit)) ("acks.scrbl" () (omit)) ("release.scrbl" (depends-all-main no-depend-on) (omit)))) diff --git a/pkgs/racket-pkgs/racket-index/setup/scribble.rkt b/pkgs/racket-pkgs/racket-index/setup/scribble.rkt index 920331c2ae..6096f90c43 100644 --- a/pkgs/racket-pkgs/racket-index/setup/scribble.rkt +++ b/pkgs/racket-pkgs/racket-index/setup/scribble.rkt @@ -4,7 +4,7 @@ setup/dirs setup/path-to-relative setup/private/path-utils - setup/main-collects + setup/collects setup/main-doc setup/parallel-do setup/doc-db @@ -26,6 +26,7 @@ racket/place pkg/lib pkg/strip + openssl/sha1 (prefix-in u: net/url) (prefix-in html: scribble/html-render) (prefix-in latex: scribble/latex-render) @@ -47,14 +48,19 @@ under-main? pkg? category - out-count) + out-count + name + order-hint) #:transparent) (define-serializable-struct info (doc ; doc structure above undef ; unresolved requires searches - deps - known-deps - build? time out-time need-run? + deps ; (listof (cons hash)) + known-deps ; (listof (cons hash)) + build? + prev-out-hash out-hash + start-time done-time + need-run? need-in-write? need-out-write? vers rendered? failed?) #:transparent @@ -63,6 +69,16 @@ (define (main-doc? doc) (pair? (path->main-doc-relative (doc-dest-dir doc)))) +(define (docmain-collects-relative dir))))]) + (hash-ref main-dirs dir #f)))]) (define src (simplify-path (build-path dir (car d)) #f)) - (define dest (doc-path dir (cadddr d) flags under-main?)) + (define name (cadddr d)) + (define dest (doc-path dir name flags under-main?)) (make-doc dir (let ([spec (directory-record-spec rec)]) (list* (car spec) @@ -174,7 +192,9 @@ dest flags under-main? (and (path->pkg src) #t) (caddr d) - (list-ref d 4)))) + (list-ref d 4) + (if (path? name) (path-element->string name) name) + (list-ref d 5)))) s) (begin (setup-printf "WARNING" @@ -183,13 +203,15 @@ null)))) (log-setup-info "getting documents") (define docs - (let* ([recs (find-relevant-directory-records '(scribblings) 'all-available)] - [main-dirs (for/hash ([k (in-list - (find-relevant-directories '(scribblings) 'no-user))]) - (values k #t))] - [infos (map get-info/full (map directory-record-path recs))]) - (filter-user-docs (append-map (get-docs main-dirs) infos recs) - make-user?))) + (sort + (let* ([recs (find-relevant-directory-records '(scribblings) 'all-available)] + [main-dirs (for/hash ([k (in-list + (find-relevant-directories '(scribblings) 'no-user))]) + (values k #t))] + [infos (map get-info/full (map directory-record-path recs))]) + (filter-user-docs (append-map (get-docs main-dirs) infos recs) + make-user?)) + docinfo d #f) d))) + (cons (if (info? (car d)) + (car d) + (or (hash-ref src->info (car d) #f) + (car d))) + (cdr d))) (info-deps info))) - (unless (andmap info? (info-deps info)) + (unless (andmap (lambda (d) (info? (car d))) + (info-deps info)) (set-info-need-in-write?! info #t)) ;; Propagate existing dependencies as expected dependencies: - (for ([d (info-deps info)]) + (for ([dd (info-deps info)]) + (define d (car dd)) (let ([i (if (info? d) d (hash-ref src->info d #f))]) (if i ;; Normal case: @@ -394,25 +422,30 @@ ;; Path has no info; normally keep it as expected, and it gets ;; removed later. (unless (or (memq 'depends-all (doc-flags (info-doc info))) - (and (if (info? d) - (doc-under-main? (info-doc d)) - (not (path? (path->main-collects-relative d)))) + (and (info? d) + (doc-under-main? (info-doc d)) all-main?)) (set! added? #t) (when (verbose) - (printf " [Removed Dependency: ~a]\n" - (doc-src-file (info-doc info)))))))) + (printf " [Removed Dependency for ~a: ~a]\n" + (doc-name (info-doc info)) + (doc-name (info-doc info)))))))) (when (or (memq 'depends-all (doc-flags (info-doc info))) all-main?) ;; Add all as expected dependency: (when (verbose) - (printf " [Adding all~a as dependencies: ~a]\n" + (printf " [Adding all~a as dependencies for ~a]\n" (if all-main? " main" "") - (doc-src-file (info-doc info)))) + (doc-name (info-doc info)))) (for ([i infos]) + (hash-set! known-deps i #t) (when (and (not (eq? i info)) (not (hash-ref deps i #f)) (or (not all-main?) (doc-under-main? (info-doc i))) (not (memq 'no-depend-on (doc-flags (info-doc i))))) + (when (verbose) + (printf " [Adding for ~a: ~a]\n" + (doc-name (info-doc info)) + (doc-name (info-doc i)))) (set! added? #t) (hash-set! deps i #t)))) ;; Add definite dependencies based on referenced keys @@ -442,81 +475,87 @@ (for ([found-dep (in-list found-deps)]) ;; Record a definite dependency: (define i (out-path->info found-dep infos out-path->info-cache)) + (unless i + (error "failed to find info for path: ~s" found-dep)) (when (not (hash-ref known-deps i #f)) (hash-set! known-deps i #t)) - ;; Record also in the expected-dependency list: - (when (not (hash-ref deps i #f)) - (set! added? #t) - (when (verbose) - (printf " [Adding... ~a]\n" - (doc-src-file (info-doc i)))) - (hash-set! deps i #t))) + ;; Record also in the expected-dependency list: + (when (not (hash-ref deps i #f)) + (set! added? #t) + (when (verbose) + (printf " [Adding for ~a: ~a]\n" + (doc-name (info-doc info)) + (doc-name (info-doc i)))) + (hash-set! deps i #t))) (for ([s-key (in-list missing)]) (not-found s-key)))) - ;; If we added anything (expected or known), then mark as needed to run - (when added? - (when (verbose) - (printf " [Added Dependency: ~a]\n" - (doc-src-file (info-doc info)))) - (set-info-deps! info (hash-map deps (lambda (k v) k))) - (set-info-known-deps! info (hash-map known-deps (lambda (k v) k))) + (when (or + ;; If we added anything (expected or known), then mark as needed to run: + (and added? + (when (verbose) + (printf " [Rerun, since added dependencies for ~a]\n" + (doc-name (info-doc info))))) + ;; If any dependency change, then mark as needed to run: + (and (let ([ch (ormap (lambda (p) + (define i2 (car p)) + (or (and (not (info? i2)) + i2) + (and (not (equal? (info-out-hash i2) (cdr p))) + i2))) + (info-deps info))]) + (and ch + (when (verbose) + (printf " [Rerun, since dependency changed for ~a: ~a]\n" + (doc-name (info-doc info)) + (if (info? ch) + (doc-name (info-doc ch)) + ch))))))) + (define (key->dep i v) (cons i + (if ((info-start-time info) . > . (info-done-time i)) + ;; This document started after latest info was availale: + (info-out-hash i) + ;; Used info that was available at the start: + (info-prev-out-hash i)))) + (set-info-known-deps! info (hash-map known-deps key->dep)) + (set-info-deps! info (info-known-deps info)) (set-info-need-in-write?! info #t) (set-info-need-run?! info #t)))) - ;; If any expected dependency changed, then we need a re-run: - (for ([i infos] - #:unless (or (info-need-run? i) (not (info-build? i)))) - (let ([ch (ormap (lambda (i2) - (or (and (not (info? i2)) - i2) - (and (>= (info-out-time i2) (info-time i)) i2))) - (info-deps i))]) - (when ch - (when (verbose) - (printf " [Dependency: ~a\n <- ~a]\n" - (doc-src-file (info-doc i)) - (if (info? ch) - (doc-src-file (info-doc ch)) - ch))) - (set-info-need-run?! i #t)))) ;; Iterate, if any need to run: (when (and (ormap info-need-run? infos) (iter . < . 30)) (log-setup-info "building") ;; Build again, using dependencies - (let ([need-rerun (filter-map (lambda (i) - (and (info-need-run? i) - (begin - (when (info-need-in-write? i) - (write-in/info latex-dest i no-lock) - (set-info-need-in-write?! i #f)) - (set-info-deps! i (filter info? (info-deps i))) - (set-info-need-run?! i #f) - i))) - infos)]) + (let ([need-rerun (sort (filter-map (lambda (i) + (and (info-need-run? i) + (begin + (set-info-need-run?! i #f) + i))) + infos) + inforelative-string/setup (doc-src-file (info-doc i))))) - (define (update-info info response) + (define (prep-info! i) + (set-info-start-time! i (current-inexact-milliseconds)) + (set-info-prev-out-hash! i (info-out-hash i))) + (define (update-info! info response) (match response [#f (set-info-failed?! info #t)] - [(list in-delta? out-delta? undef searches) + [(list undef searches out-delta?) (set-info-rendered?! info #t) (set-info-undef! info undef) (set-info-searches! info searches) + (set-info-need-in-write?! info #f) (when out-delta? - (set-info-out-time! info (/ (current-inexact-milliseconds) 1000))) - (when in-delta? - ;; Reset expected dependencies to known dependencies, and recompute later: - (set-info-deps! info (info-known-deps info)) - (set-info-need-in-write?! info #t)) - (set-info-time! info (/ (current-inexact-milliseconds) 1000))])) + (set-info-out-hash! info (get-info-out-hash (info-doc info) latex-dest)) + (set-info-done-time! info (current-inexact-milliseconds)))])) (if ((min worker-count (length need-rerun)) . < . 2) - (map (lambda (i) - (say-rendering i #f) - (update-info i (build-again! latex-dest i with-record-error no-lock))) - need-rerun) + (for ([i (in-list need-rerun)]) + (say-rendering i #f) + (prep-info! i) + (update-info! i (build-again! latex-dest i with-record-error no-lock))) (parallel-do (min worker-count (length need-rerun)) (lambda (workerid) @@ -526,11 +565,20 @@ need-rerun (lambda (i workerid) (say-rendering i workerid) - (s-exp->fasl (serialize (info-doc i)))) + (prep-info! i) + (s-exp->fasl (serialize (list (info-doc i) + ;; Other content of `info' can be re-read from + ;; "in.sxref", but not the dependencies and the + ;; fact that we need to write the dependencies, + ;; because those should only be written after + ;; a successful render. So, we pass them along + ;; in this list: + (info-deps->rel-doc-src-file i) + (info-need-in-write? i))))) (lambda (i r outstr errstr) (printf "~a" outstr) (printf "~a" errstr) - (update-info i (deserialize (fasl->s-exp r)))) + (update-info! i (deserialize (fasl->s-exp r)))) (lambda (i errmsg outstr errstr) (parallel-do-error-handler setup-printf (info-doc i) errmsg outstr errstr))) (define-worker (build-again!-worker2 workerid verbosev latex-dest lock-ch) @@ -738,15 +786,6 @@ (for ([i skip]) (fasl->s-exp x)) (fasl->s-exp x)))) -(define (file-or-directory-modify-seconds/stamp file - stamp-time stamp-data pos - get-sha1) - (let ([t (file-or-directory-modify-seconds file #f (lambda () +inf.0))]) - (cond - [(t . <= . stamp-time) stamp-time] - [(equal? (list-ref stamp-data pos) (get-sha1 file)) stamp-time] - [else t]))) - (define (find-db-file doc latex-dest) (define p (find-doc-db-path latex-dest (not (main-doc? doc)))) (define-values (base name dir?) (split-path p)) @@ -767,6 +806,15 @@ (xref-transfer-info renderer ci xref) shutdown) +(define (get-info-out-hash doc latex-dest) + (define info-out-files (for/list ([i (add1 (doc-out-count doc))]) + (sxref-path latex-dest doc (format "out~a.sxref" i)))) + (define-values (i o) (make-pipe)) + (for/list ([info-out-file info-out-files]) + (display (get-file-sha1 info-out-file) o)) + (close-output-port o) + (sha1 i)) + (define ((get-doc-info only-dirs latex-dest auto-main? auto-user? with-record-error setup-printf workerid only-fast? force-out-of-date? lock) @@ -800,9 +848,9 @@ #f ;; need to render, so complain if no source is available: path)))] + [src-sha1 (and src-zo (get-compiled-file-sha1 src-zo))] [renderer (make-renderer latex-dest doc)] [can-run? (can-build? only-dirs doc)] - [stamp-time (file-or-directory-modify-seconds stamp-file #f (lambda () -inf.0))] [stamp-data (with-handlers ([exn:fail:filesystem? (lambda (exn) (list "" "" ""))]) (let ([v (call-with-input-file* stamp-file read)]) (if (and (list? v) @@ -818,15 +866,9 @@ (let-values ([(base name dir?) (split-path p)]) (build-path base "compiled" (path-add-suffix name ".zo"))))] [css-path (collection-file-path "scribble.css" "scribble")] - [aux-time (max (file-or-directory-modify-seconds/stamp - renderer-path - stamp-time stamp-data 1 - get-compiled-file-sha1) - (file-or-directory-modify-seconds/stamp - css-path - stamp-time stamp-data 2 - get-file-sha1))] - [my-time (file-or-directory-modify-seconds out-file #f (lambda () -inf.0))] + [aux-sha1s (list (get-compiled-file-sha1 renderer-path) + (get-file-sha1 css-path))] + [out-exists? (file-exists? out-file)] [info-out-time (for/fold ([t +inf.0]) ([info-out-file info-out-files]) (and t (let ([t2 (file-or-directory-modify-seconds info-out-file #f (lambda () #f))]) @@ -835,29 +877,23 @@ (and t (let ([t2 (doc-db-get-provides-timestamp db-file info-out-file)]) (and t2 (min t t2)))))] - [info-in-time (file-or-directory-modify-seconds info-in-file #f (lambda () #f))] - [info-time (min (or info-out-time -inf.0) (or info-in-time -inf.0))] + [info-in-exists? (file-exists? info-in-file)] [vers (send renderer get-serialize-version)] - [src-time (and src-zo - (file-or-directory-modify-seconds/stamp - src-zo - stamp-time stamp-data 0 - get-compiled-file-sha1))] - [up-to-date? - (or (and (not src-zo) - info-in-time - info-out-time) - (and (not force-out-of-date?) - info-out-time - info-in-time - provides-time - (or (not can-run?) - ;; Need to rebuild if output file is older than input: - (my-time . >= . src-time) - ;; But we can use in/out information if they're already built; - ;; this is mostly useful if we interrupt setup-plt after - ;; it runs some documents without rendering them: - (info-time . >= . src-time))))] + [use-built? (and (not src-zo) + info-in-exists? + info-out-time)] + [out-of-date (and (not use-built?) + (or (and force-out-of-date? + 'force) + (and (not info-out-time) + 'missing-out) + (and (not info-in-exists?) + 'missing-in) + (and can-run? + (not (equal? (car stamp-data) + src-sha1)) + 'newer)))] + [up-to-date? (not out-of-date)] [can-run? (and src-zo (or (not latex-dest) (not (omit? (doc-category doc)))) @@ -866,8 +902,11 @@ (memq 'depends-all-main (doc-flags doc))) (and auto-user? (memq 'depends-all (doc-flags doc)))))]) + (when (or (and (not up-to-date?) (not only-fast?)) (verbose)) + (when (and (verbose) out-of-date) + (printf " [Need run (~a) ~a]\n" out-of-date (doc-name doc))) (setup-printf (string-append (if workerid (format "~a " workerid) "") @@ -879,7 +918,7 @@ [else "skipping"])) "~a" (path->relative-string/setup (doc-src-file doc)))) - + (when force-out-of-date? (for ([p (in-list info-out-files)]) (when (file-exists? p) @@ -901,20 +940,25 @@ (let ([v-in (load-sxref info-in-file)]) (unless (equal? (car v-in) (list vers (doc-flags doc))) (error "old info has wrong version or flags")) + (define out-hash (get-info-out-hash doc latex-dest)) (make-info doc 'delayed 'delayed - (map rel->path (list-ref v-in 1)) ; expected deps, in case we don't need to build... + ;; expected deps, in case we don't need to build: + (map (lambda (p) (cons (rel->path (car p)) (cdr p))) + (list-ref v-in 1)) null ; known deps (none at this point) can-run? - my-time info-out-time + out-hash out-hash + (current-inexact-milliseconds) -inf.0 (and can-run? (or (memq 'always-run (doc-flags doc)) ;; maybe info is up-to-date but not rendered doc: - (not (my-time . >= . src-time)))) + (not out-exists?))) #f - ;; Need to write if database is out of sync: + ;; Need to write if database is out of sync. A timestamp is good enough, + ;; insteda of sha1s, because a database is never moved across installations. (provides-time . < . info-out-time) vers #f @@ -926,7 +970,8 @@ (doc-src-file doc) (lambda () (parameterize ([current-directory (doc-src-dir doc)]) - (let* ([v (load-doc/ensure-prefix doc)] + (let* ([start-time (current-inexact-milliseconds)] + [v (load-doc/ensure-prefix doc)] [dest-dir (pick-dest latex-dest doc)] [fp (send renderer traverse (list v) (list dest-dir))] [ci (send renderer collect (list v) (list dest-dir) fp)] @@ -936,11 +981,6 @@ [db-shutdown (xref-transfer-db renderer ci doc latex-dest #:quiet-fail? #t)] [ri (send renderer resolve (list v) (list dest-dir) ci)] [out-vs (and info-out-time - ;; Don't force a re-write of "out" just because the document - ;; is newer: - ;; (info-out-time . >= . src-time) - ;; We check further belew whether the "out" content actually - ;; has changed to decide whether it must be written. (with-handlers ([exn:fail? (lambda (exn) #f)]) (for/list ([info-out-file info-out-files]) (let ([v (load-sxref info-out-file)]) @@ -963,10 +1003,9 @@ (serialized=? sci (cadr out-v)))) 'content) (and (not provides-time) 'db-missing) - (and (info-out-time . > . provides-time) 'db-older) - (and (info-out-time . > . (current-seconds)) 'time-inversion))]) + (and (info-out-time . > . provides-time) 'db-older))]) (when (and (verbose) need-out-write) - (printf " [New out (~a) ~a]\n" need-out-write (doc-src-file doc))) + (printf " [New out (~a) ~a]\n" need-out-write (doc-name doc))) (gc-point) (let ([info (make-info doc @@ -975,10 +1014,10 @@ null ; no deps, yet null ; no known deps, yet can-run? - -inf.0 - (if need-out-write - (/ (current-inexact-milliseconds) 1000) - info-out-time) + #f ; prev-out-hash + (and (not need-out-write) + (get-info-out-hash doc latex-dest)) + start-time +inf.0 #t can-run? (and need-out-write #t) @@ -987,20 +1026,18 @@ #f)]) (when need-out-write (render-time "xref-out" (write-out/info latex-dest info scis defss db-file lock)) - (set-info-need-out-write?! info #f)) + (set-info-out-hash! info (get-info-out-hash doc latex-dest)) + (set-info-need-out-write?! info #f) + (set-info-done-time! info (current-inexact-milliseconds))) (when (info-need-in-write? info) (render-time "xref-in" (write-in/info latex-dest info lock)) (set-info-need-in-write?! info #f)) - (when (or (stamp-time . < . aux-time) - (stamp-time . < . src-time)) - (let ([data (list (and src-zo (get-compiled-file-sha1 src-zo)) - (get-compiled-file-sha1 renderer-path) - (get-file-sha1 css-path))]) - (with-compile-output stamp-file (lambda (out tmp-filename) (write data out))) - (let ([m (max aux-time src-time)]) - (unless (equal? m +inf.0) - (file-or-directory-modify-seconds stamp-file m))))) + (let ([data (cons src-sha1 aux-sha1s)]) + (unless (equal? data stamp-data) + (with-compile-output + stamp-file + (lambda (out tmp-filename) (write data out))))) (db-shutdown) info)))) (lambda () #f)) @@ -1108,7 +1145,7 @@ (let ([end (current-process-milliseconds)]) (log-setup-debug "~a: ~a msec" what (- end start))))) -(define (load-sxrefs latex-dest doc vers) +(define (load-sxrefs latex-dest doc vers new-deps-rel) (define in-filename (sxref-path latex-dest doc "in.sxref")) (match (list (load-sxref in-filename) (load-sxref in-filename #:skip 1) @@ -1129,11 +1166,14 @@ [(list undef searches) (with-my-namespace* (values undef - deps-rel + new-deps-rel searches scis))])])) -(define (build-again! latex-dest info with-record-error lock) +(define (build-again! latex-dest info-or-list with-record-error lock) + ;; If `info-or-list' is a list, then we're in a parallel build, and + ;; it provides just enough of `info' from the main place to re-build + ;; in this place along with the content of "in.sxref". (define (cleanup-dest-dir doc) (unless latex-dest (let ([dir (doc-dest-dir doc)]) @@ -1148,22 +1188,23 @@ (define (load-doc-scis doc) (map cadr (for/list ([i (add1 (doc-out-count doc))]) (load-sxref (sxref-path latex-dest doc (format "out~a.sxref" i)))))) - (define doc (if (info? info) (info-doc info) info)) + (define info (and (info? info-or-list) info-or-list)) + (define doc (if info (info-doc info) (car info-or-list))) (define renderer (make-renderer latex-dest doc)) (with-record-error (doc-src-file doc) (lambda () (define vers (send renderer get-serialize-version)) (define-values (ff-undef ff-deps-rel ff-searches ff-scis) - (if (info? info) + (if info (begin (when (eq? 'delayed (info-undef info)) (read-delayed-in! info latex-dest)) - (values (info-undef info) + (values (info-undef info) (info-deps->rel-doc-src-file info) (info-searches info) (load-doc-scis doc))) - (load-sxrefs latex-dest doc vers))) + (load-sxrefs latex-dest doc vers (cadr info-or-list)))) (parameterize ([current-directory (doc-src-dir doc)]) (let* ([v (render-time "load" (load-doc/ensure-prefix doc))] @@ -1188,9 +1229,11 @@ (cond [out-delta? "New out "] [in-delta? ""] [else "No change "]) - (doc-src-file doc))) + (doc-name doc))) - (when in-delta? + (when (or in-delta? + (and info (info-need-in-write? info)) + (and (not info) (caddr info-or-list))) (render-time "xref-in" (write-in latex-dest vers doc undef ff-deps-rel searches db-file lock))) (when out-delta? (render-time "xref-out" (write-out latex-dest vers doc scis defss db-file lock))) @@ -1210,7 +1253,7 @@ (close-output-port (open-output-file synced))))) (db-shutdown) (gc-point) - (list in-delta? out-delta? undef searches)))) + (list undef searches out-delta?)))) (lambda () #f))) (define (gc-point) @@ -1333,10 +1376,10 @@ (define (rel->path r) (if (bytes? r) (bytes->path r) - (main-collects-relative->path r))) + (collects-relative->path r))) (define (path->rel r) - (let ([r (path->main-collects-relative r)]) + (let ([r (path->collects-relative r)]) (if (path? r) (path->bytes r) r))) @@ -1344,20 +1387,23 @@ (define (doc->rel-doc d) (struct-copy doc d - [src-dir (path->main-collects-relative (doc-src-dir d))] - [src-file (path->main-collects-relative (doc-src-file d))] + [src-dir (path->collects-relative (doc-src-dir d))] + [src-file (path->collects-relative (doc-src-file d))] [dest-dir (path->main-doc-relative (doc-dest-dir d))])) (define (rel-doc->doc d) (struct-copy doc d - [src-dir (main-collects-relative->path (doc-src-dir d))] - [src-file (main-collects-relative->path (doc-src-file d))] + [src-dir (collects-relative->path (doc-src-dir d))] + [src-file (collects-relative->path (doc-src-file d))] [dest-dir (main-doc-relative->path (doc-dest-dir d))])) (define (info-deps->rel-doc-src-file info) - (filter-map (lambda (i) (and (info? i) - (path->rel (doc-src-file (info-doc i))))) + (filter-map (lambda (ii) + (define i (car ii)) + (and (info? i) + (cons (path->rel (doc-src-file (info-doc i))) + (cdr ii)))) (info-deps info))) (define (info-deps->doc info) diff --git a/racket/lib/collects/setup/setup-unit.rkt b/racket/lib/collects/setup/setup-unit.rkt index 8ef9eb0d3a..e0687a9872 100644 --- a/racket/lib/collects/setup/setup-unit.rkt +++ b/racket/lib/collects/setup/setup-unit.rkt @@ -1049,7 +1049,8 @@ [else (path->bytes (cc-path cc))]) (cons (domain) (cc-shadowing-policy cc))))) ;; In "tidy" mode, make sure we check each "cache.rktd": - (when (make-tidy) + (when (or (make-tidy) + no-specific-collections?) (for ([c (in-list (current-library-collection-paths))]) (when (and (directory-exists? c) (not (and (avoid-main-installation)