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

raco setup: better tracking of provides in database

Browse Source 
Keep track of the out<n>.sxref timestamps, so that `raco setup'
can detect when the database is out of sync (instead of assuming that
it's always in sync with out<n>.sxref files).
This commit is contained in:
Matthew Flatt 2013-06-19 18:19:36 -06:00
parent 2e781d32f7
commit 8bd81d456b
2 changed files with 76 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -810,6 +810,10 @@
(and t
(let ([t2 (file-or-directory-modify-seconds info-out-file #f (lambda () #f))])
(and t2 (min t t2)))))]
[provides-time (for/fold ([t +inf.0]) ([info-out-file info-out-files])
(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))]
[vers (send renderer get-serialize-version)]
@ -823,9 +827,12 @@
(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)
;; Need to rebuild if database is out of sync:
(provides-time . >= . info-out-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:
@ -923,6 +930,8 @@
(not (for/and ([sci scis]
[out-v out-vs])
(serialized=? sci (cadr out-v))))
(not provides-time)
(info-out-time . > . provides-time)
(info-out-time . > . (current-seconds)))])
(when (and (verbose) need-out-write?)
(eprintf " [New out ~a]\n" (doc-src-file doc)))
@ -1002,7 +1011,9 @@
lock
(lambda ()
(doc-db-clear-provides db-file filename)
(doc-db-add-provides db-file provides filename))))))
(doc-db-add-provides db-file provides filename)
(doc-db-set-provides-timestamp db-file filename
(file-or-directory-modify-seconds filename)))))))
;; For each ".html" file, check for a reference to "local-redirect.js",
;; and fix up the path if there is a reference:
(define js-path (if (doc-under-main? doc)
@ -1209,7 +1220,7 @@
(dynamic-require sub 'doc)
(dynamic-require mod-path 'doc))))))))
(define (write- latex-dest vers doc name datas prep!)
(define (write- latex-dest vers doc name datas prep! final!)
(let* ([filename (sxref-path latex-dest doc name)])
(prep! filename)
(when (verbose) (printf " [Caching to disk ~a]\n" filename))
@ -1220,9 +1231,22 @@
(for ([data (in-list datas)])
(write-bytes (s-exp->fasl (append (list (list vers (doc-flags doc)))
data))
out))))))
out))))
(final! filename)))
(define (write-out latex-dest vers doc scis providess db-file lock)
;; A "provides.sxref" file is used when a package is converted to binary
;; form, in which case cross-reference information needs to be loaded
;; into the database at install time:
(when (and (doc-pkg? doc)
(not (doc-under-main? doc))
(not latex-dest))
(with-compile-output
(sxref-path latex-dest doc "provides.sxref")
(lambda (out tmp-filename)
(s-exp->fasl providess out))))
;; Write each "out.sxref" file and install the corresponding provides
;; into the database:
(for ([i (add1 (doc-out-count doc))]
[sci scis]
[provides providess])
@ -1233,15 +1257,14 @@
lock
(lambda ()
(doc-db-clear-provides db-file filename)
(doc-db-add-provides db-file provides filename))))))
;; Used for a package is converted to "binary" form:
(when (and (doc-pkg? doc)
(not (doc-under-main? doc))
(not latex-dest))
(with-compile-output
(sxref-path latex-dest doc "provides.sxref")
(lambda (out tmp-filename)
(s-exp->fasl providess out)))))
(doc-db-add-provides db-file provides filename))))
(lambda (filename)
(call-with-lock
lock
(lambda ()
(doc-db-set-provides-timestamp
db-file filename
(file-or-directory-modify-seconds filename))))))))
(define (write-out/info latex-dest info scis providess db-file lock)
(write-out latex-dest (info-vers info) (info-doc info) scis providess db-file lock))
@ -1258,7 +1281,8 @@
(doc-db-clear-dependencies db-file filename)
(doc-db-clear-searches db-file filename)
(doc-db-add-dependencies db-file undef filename)
(doc-db-add-searches db-file searches filename))))))
(doc-db-add-searches db-file searches filename))))
void))
(define (write-in/info latex-dest info lock)
(when (eq? 'delayed (info-undef info))

40
racket/lib/collects/setup/doc-db.rkt
View File

@ -7,6 +7,8 @@
(provide doc-db-available?
doc-db-clear-provides
doc-db-add-provides
doc-db-set-provides-timestamp
doc-db-get-provides-timestamp
doc-db-clear-dependencies
doc-db-add-dependencies
doc-db-clear-searches
@ -135,6 +137,33 @@
db-file filename
"DELETE FROM documented WHERE pathid=$1"))
(define (doc-db-set-provides-timestamp db-file filename seconds)
(call-with-database
'doc-db-set-provides-timestamp
db-file
#:write? #t
(lambda (db)
(prepare-tables db)
(define pathid (filename->pathid db filename))
(query-exec db "DELETE FROM timestamps WHERE pathid=$1"
pathid)
(query-exec db "INSERT INTO timestamps VALUES ($1, $2)"
pathid seconds))))
(define (doc-db-get-provides-timestamp db-file filename)
(call-with-database
'doc-db-get-provides-timestamp
db-file
#:write? #t
(lambda (db)
(prepare-tables db)
(define pathid (filename->pathid db filename))
(define row
(query-maybe-row db (~a "SELECT seconds FROM timestamps"
" WHERE pathid=$1")
pathid))
(and row (vector-ref row 0)))))
(define (doc-db-add-dependencies db-file depends filename)
(add 'doc-db-add-dependencies
db-file depends filename
@ -355,6 +384,8 @@
(define pathid (vector-ref row 2))
(query-exec db "DELETE FROM documented WHERE pathid=$1"
pathid)
(query-exec db "DELETE FROM timestamps WHERE pathid=$1"
pathid)
(query-exec db "DELETE FROM searches WHERE pathid=$1"
pathid)
(query-exec db "DELETE FROM searchSets WHERE pathid=$1"
@ -441,7 +472,14 @@
(query-exec db (~a "CREATE INDEX searchesTag "
"on searches (stag)"))
(query-exec db (~a "CREATE INDEX searchesPathId "
"on searches (pathid, setid)"))))
"on searches (pathid, setid)")))
(when (null?
(query-rows db (~a "SELECT name FROM sqlite_master"
" WHERE type='table' AND name='timestamps'")))
(query-exec db (~a "CREATE TABLE timestamps "
"(pathid SMALLINT,"
" seconds BIGINT,"
" PRIMARY KEY (pathid))"))))
(define (exn:fail:retry? v)
(and (exn:fail:sql? v)