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

Closes #1611
This commit is contained in:
Matthew Flatt 2021-05-15 11:09:55 -06:00
parent 5dc5bd7ae9
commit 304904da50

View File

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