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

raco pkg: fix documentation indexing for user-scoped re-link

Browse Source 
If a package installed as a link in user scope, then removed, then
linked again, the documentation index database was not updated
correctly. As a result, the user-specific documentation page was
either not updated or had a broken link for the document.
This commit is contained in:
Matthew Flatt 2014-04-28 20:22:49 -06:00
parent dee331e3b1
commit ae14ff70df
1 changed files with 17 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1099,6 +1099,17 @@
(let ([v-in (load-sxref info-in-file)]) (let ([v-in (load-sxref info-in-file)])
(unless (equal? (car v-in) (list vers (doc-flags doc))) (unless (equal? (car v-in) (list vers (doc-flags doc)))
(error "old info has wrong version or flags")) (error "old info has wrong version or flags"))
(when (and (or (not provides-time)
(provides-time . < . info-out-time))
(can-build? only-dirs doc))
;; Database is out of sync, and we don't need to build
;; this document, so update databse now. Note that a
;; timestamp is good enough for determing a sync,
;; instead of sha1s, because a database is never moved
;; across installations.
(move-documentation-into-place doc #f
setup-printf workerid lock
main-doc-exists?))
(define out-hash (get-info-out-hash doc latex-dest)) (define out-hash (get-info-out-hash doc latex-dest))
(make-info (make-info
doc doc
@ -1115,10 +1126,7 @@
;; maybe info is up-to-date but not rendered doc: ;; maybe info is up-to-date but not rendered doc:
(not out-exists?))) (not out-exists?)))
#f #f
;; Need to write if database is out of sync. A timestamp is good enough, #f
;; instead of sha1s, because a database is never moved across installations.
(or (not provides-time)
(provides-time . < . info-out-time))
vers vers
#f #f
#f)))) #f))))
@ -1236,15 +1244,15 @@
;; the job of the regular documentation builder. ;; the job of the regular documentation builder.
(log-error (exn-message exn)))]) (log-error (exn-message exn)))])
(define dest-dir (doc-dest-dir doc)) (define dest-dir (doc-dest-dir doc))
(define move? (not (equal? (file-or-directory-identity src-dir) (define move? (and src-dir
(not (equal? (file-or-directory-identity src-dir)
(and (directory-exists? dest-dir) (and (directory-exists? dest-dir)
(file-or-directory-identity dest-dir))))) (file-or-directory-identity dest-dir))))))
(setup-printf (string-append (setup-printf (string-append
(if workerid (format "~a " workerid) "") (if workerid (format "~a " workerid) "")
(if move? "moving" "syncing")) (if move? "moving" "syncing"))
"~a" "~a"
(path->relative-string/setup src-dir)) (path->relative-string/setup (or src-dir dest-dir)))
(when move? (when move?
(when (directory-exists? dest-dir) (when (directory-exists? dest-dir)
(delete-directory/files dest-dir)) (delete-directory/files dest-dir))