setup/xref: fix load-collections-xref for multple uses

When the result of `load-collections-xref` is used in multiple
document renderings (e.g., multiple calls to `render`), then an
intenal cache behaved the wrong way. Fixing the problem required an
extension to `scribble/xref`.
This commit is contained in:
Matthew Flatt 2020-05-24 11:05:53 -06:00
parent 462a4f5c37
commit f66fff1ca9
3 changed files with 27 additions and 20 deletions

View File

@ -6,7 +6,7 @@
["base" #:version "6.5.0.2"]
"net-lib"
"sandbox-lib"
["scribble-lib" #:version "1.14"]
["scribble-lib" #:version "1.34"]
"racket-index"))
(define build-deps '("rackunit-doc"
"compatibility"

View File

@ -2157,11 +2157,10 @@ Returns @racket[#t] if cross-installation mode has been detected,
@defproc[(load-collections-xref [on-load (-> any/c) (lambda () (void))])
xref?]{
Like @racket[load-xref], but automatically find all cross-reference files for
manuals that have been installed with @exec{raco setup}.
A cached copy of cross-reference information can be used, in which
case @racket[on-load] is @emph{not} called.}
Either creates and caches or returns a cached cross-reference record
created with @racket[make-collections-xref]. The @racket[on-load]
function is called only when a previously cached record is not
returned.}
@defproc[(make-collections-xref [#:no-user? no-user? any/c #f]
@ -2171,7 +2170,9 @@ case @racket[on-load] is @emph{not} called.}
[#:register-shutdown! register-shutdown! ((-> any) . -> . any) void])
xref?]{
Like @racket[load-collections-xref], but takes advantage of a
Like @racket[load-xref], but automatically finds all cross-reference
files for manuals that have been installed with @exec{raco setup}.
The resulting cross-reference record takes advantage of a
cross-reference database @racket[db-path], when support is available,
to delay the loading of cross-reference details until needed.

View File

@ -103,20 +103,25 @@
(close p))))
(when main-db (close main-db))
(when user-db (close user-db))))
(define done-ht (make-hash)) ; tracks already-loaded documents
(define forced-all? #f)
(define (force-all)
(define done-hts (make-hasheq)) ; tracks already-loaded documents per ci
(define (get-done-ht use-id)
(or (hash-ref done-hts use-id #f)
(let ([ht (make-hash)])
(hash-set! done-hts use-id ht)
ht)))
(define forced-all?s (make-hasheq)) ; per ci: whether forced all
(define (force-all use-id)
;; force all documents
(define thunks (get-reader-thunks no-user? no-main? quiet-fail? done-ht))
(set! forced-all? #t)
(define thunks (get-reader-thunks no-user? no-main? quiet-fail? (get-done-ht use-id)))
(hash-set! forced-all?s use-id #t)
(lambda ()
;; return a procedure so we can produce a list of results:
(lambda ()
(for/list ([thunk (in-list thunks)])
(thunk)))))
(lambda (key)
(lambda (key use-id)
(cond
[forced-all? #f]
[(hash-ref forced-all?s use-id #f) #f]
[key
(define (try p)
(and p
@ -140,11 +145,11 @@
(define dest (or (try main-db) (try user-db)))
(and dest
(if (eq? dest #t)
(force-all)
((dest->source done-ht quiet-fail?) dest)))]
(force-all use-id)
((dest->source (get-done-ht use-id) quiet-fail?) dest)))]
[else
(unless forced-all?
(force-all))])))
(unless (hash-ref forced-all?s use-id #f)
(force-all use-id))])))
(define (get-reader-thunks no-user? no-main? quiet-fail? done-ht)
(map (dest->source done-ht quiet-fail?)
@ -165,8 +170,9 @@
#:register-shutdown! [register-shutdown! void])
(if (doc-db-available?)
(load-xref null
#:demand-source (make-key->source db-path no-user? no-main? quiet-fail?
register-shutdown!))
#:demand-source-for-use
(make-key->source db-path no-user? no-main? quiet-fail?
register-shutdown!))
(load-xref (get-reader-thunks no-user? no-main? quiet-fail? (make-hash)))))