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

raco setup: make --clean respect --avoid-main and --no-user

Browse Source 
Closes #1611
This commit is contained in:
Matthew Flatt 2021-05-15 11:09:55 -06:00
parent 5dc5bd7ae9
commit 304904da50
1 changed files with 33 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
racket/collects/setup/setup-core.rkt
View File

@ -795,8 +795,8 @@
(when (and (pair? deps) (list? deps)) (when (and (pair? deps) (list? deps))
(for ([s (in-list (cdddr deps))]) (for ([s (in-list (cdddr deps))])
(unless (external-dep? s) (unless (external-dep? s)
(define new-s (dep->path s)) (define new-s (dep->path s))
(when (path-string? new-s) (hash-set! dependencies new-s #t)))))) (when (path-string? new-s) (hash-set! dependencies new-s #t))))))
(delete-file path)) (delete-file path))
(define (delete-files-in-directory path printout dependencies) (define (delete-files-in-directory path printout dependencies)
@ -877,22 +877,24 @@
;; Unless specific collections were named, also delete .zos for ;; Unless specific collections were named, also delete .zos for
;; referenced modules and delete info-domain cache ;; referenced modules and delete info-domain cache
(when no-specific-collections? (when no-specific-collections?
(setup-printf #f "checking dependencies") (unless (or (avoid-main-installation)
(let loop ([old-dependencies dependencies]) (not (make-user)))
(define dependencies (make-hash)) (setup-printf #f "checking dependencies")
(define did-something? #f) (let loop ([old-dependencies dependencies])
(hash-for-each (define dependencies (make-hash))
old-dependencies (define did-something? #f)
(lambda (file _) (hash-for-each
(define-values [dir name dir?] (split-path file)) old-dependencies
(define zo (build-path dir mode-dir (path-add-extension name #".zo"))) (lambda (file _)
(define dep (build-path dir mode-dir (path-add-extension name #".dep"))) (define-values [dir name dir?] (split-path file))
(when (and (file-exists? dep) (file-exists? zo)) (define zo (build-path dir mode-dir (path-add-extension name #".zo")))
(set! did-something? #t) (define dep (build-path dir mode-dir (path-add-extension name #".dep")))
(setup-printf "deleting" "~a" (path->relative-string/setup zo #:cache pkg-path-cache)) (when (and (file-exists? dep) (file-exists? zo))
(delete-file/record-dependency zo dependencies) (set! did-something? #t)
(delete-file/record-dependency dep dependencies)))) (setup-printf "deleting" "~a" (path->relative-string/setup zo #:cache pkg-path-cache))
(when did-something? (loop dependencies))) (delete-file/record-dependency zo dependencies)
(delete-file/record-dependency dep dependencies))))
(when did-something? (loop dependencies))))
(when (make-info-domain) (when (make-info-domain)
(setup-printf #f "clearing info-domain caches") (setup-printf #f "clearing info-domain caches")
(define (check-one-info-domain fn) (define (check-one-info-domain fn)
@ -900,12 +902,21 @@
(with-handlers ([exn:fail:filesystem? (warning-handler (void))]) (with-handlers ([exn:fail:filesystem? (warning-handler (void))])
(with-output-to-file fn void #:exists 'truncate/replace)))) (with-output-to-file fn void #:exists 'truncate/replace))))
(for ([p (current-library-collection-paths)]) (for ([p (current-library-collection-paths)])
(check-one-info-domain (build-path p "info-domain" "compiled" "cache.rktd"))) (unless (or (and (avoid-main-installation) (hash-ref main-collects-dirs p #f))
(check-one-info-domain (build-path (find-share-dir) "info-cache.rktd")) (and (not (make-user)) (not (hash-ref main-collects-dirs p #f))))
(check-one-info-domain (build-path (find-user-share-dir) "info-cache.rktd"))) (check-one-info-domain (build-path p "info-domain" "compiled" "cache.rktd"))))
(unless (avoid-main-installation)
(check-one-info-domain (build-path (find-share-dir) "info-cache.rktd")))
(when (make-user)
(check-one-info-domain (build-path (find-user-share-dir) "info-cache.rktd"))))
(when make-docs? (when make-docs?
(setup-printf #f "deleting documentation databases") (setup-printf #f "deleting documentation databases")
(for ([d (in-list (list (find-doc-dir) (find-user-doc-dir)))]) (for ([d (in-list (append (if (avoid-main-installation)
null
(list (find-user-doc-dir)))
(if (make-user)
(list (find-user-doc-dir))
null)))])
(when d (when d
(define f (build-path d "docindex.sqlite")) (define f (build-path d "docindex.sqlite"))
(when (file-exists? f) (when (file-exists? f)