diff --git a/pkgs/racket-doc/scribblings/raco/setup.scrbl b/pkgs/racket-doc/scribblings/raco/setup.scrbl index 4fb96befb3..1263b0f973 100644 --- a/pkgs/racket-doc/scribblings/raco/setup.scrbl +++ b/pkgs/racket-doc/scribblings/raco/setup.scrbl @@ -635,7 +635,18 @@ Optional @filepath{info.rkt} fields trigger additional actions by RPATH setting of @litchar{$ORIGIN} and the file is being installed to a user-specific location, then the file's RPATH is adjusted to @litchar{$ORIGIN:} followed by the path to the main installation's - library directory as reported by @racket[(find-lib-dir)].} + library directory as reported by @racket[(find-lib-dir)]. + + On Windows, deleting a previously installed foreign library may be + complicated by a lock on the file, if it is in use. To compensate, + @exec{raco setup} deletes a foriegn-library file by first renaming + the file to have the prefix @filepath{raco-setup-delete-}; it then + attempts to delete the renamed file and merely issues a warning on + a failure to delete the renamed file. Meanwhile, in modes where + @exec{raco setup} removes uninstalled libraries, it attempts to + delete any file in the foreign-library directory whose name starts + with @filepath{raco-setup-delete-} (in an attempt to clean up after + previous failures).} @item{@indexed-racket[move-foreign-libs] : @racket[(listof (and/c path-string? relative-path?))] --- Like @racket[copy-foreign-libs], @@ -646,7 +657,11 @@ Optional @filepath{info.rkt} fields trigger additional actions by path-string? relative-path?))] --- Files to copy into a directory where shared files are found. If @racket[install-platform] is defined, then the files are copied - only if the current platform matches the definition.} + only if the current platform matches the definition. + + On Windows, uninstalled files are deleted in the same way as for + @racket[copy-foreign-libs], and the name prefix + @filepath{raco-setup-delete-} is similarly special.} @item{@indexed-racket[move-shared-files] : @racket[(listof (and/c path-string? relative-path?))] --- Like @racket[copy-shared-files], @@ -657,7 +672,11 @@ Optional @filepath{info.rkt} fields trigger additional actions by path-string? relative-path? filename-extension))] --- Files to copy into a @tt{man} directory. The file suffix determines its category; for example, @litchar{.1} should be used for a @tt{man} page - describing an executable.} + describing an executable. + + On Windows, uninstalled files are deleted in the same way as for + @racket[copy-foreign-libs], and the name prefix + @filepath{raco-setup-delete-} is similarly special.} @item{@indexed-racket[move-man-pages] : @racket[(listof (and/c path-string? relative-path? filename-extension))] --- Like diff --git a/racket/collects/setup/setup-core.rkt b/racket/collects/setup/setup-core.rkt index 20fa4c7980..e2c797b2fc 100644 --- a/racket/collects/setup/setup-core.rkt +++ b/racket/collects/setup/setup-core.rkt @@ -1625,9 +1625,8 @@ #t) (unless already? (hash-set! dests dest #t) - (delete-directory/files dest #:must-exist? #f) - (let-values ([(base name dir?) (split-path dest)]) - (when (path? base) (make-directory* base))) + (delete-directory/files/hard dest) + (make-parent-directory* dest) (if (file-exists? src) (if (cc-main? cc) (copy-file src dest) @@ -1702,6 +1701,7 @@ lib-key)) (define (tidy-libs user? target-dir lib-dir installed-libs ccs-to-compile) + (clean-previous-delete-failures lib-dir path->relative-string/*) (define receipt-path (build-path lib-dir receipt-file)) (define ht (read-receipt-hash receipt-path)) (define ht2 (for/fold ([ht (hash)]) ([(k v) (in-hash ht)]) @@ -1729,7 +1729,7 @@ (directory-exists? lib-path)) (setup-printf "deleting" (string-append what " ~a") (path->relative-string/* lib-path)) - (delete-directory/files lib-path)) + (delete-directory/files/hard lib-path)) ht]))) (unless (equal? ht ht2) (setup-printf "updating" (format "~a list" what)) @@ -1805,6 +1805,47 @@ void copy-file)) + (define setup-delete-prefix #"raco-setup-delete-") + + (define (delete-directory/files/hard dest) + (cond + [(and (eq? 'windows (system-type)) + (file-exists? dest)) + ;; To handle DLLs that may be opened, try moving and then + ;; deleting. The delete may well fail, but at least the + ;; file will be out of the way for another try. + (define-values (base name dir?) (split-path dest)) + (define delete-dest (build-path base + (bytes->path-element + (bytes-append + setup-delete-prefix + (path-element->bytes name))))) + (rename-file-or-directory dest delete-dest #t) + (try-delete-file delete-dest)] + [else + (delete-directory/files dest #:must-exist? #f)])) + + (define (try-delete-file f) + (with-handlers ([exn:fail:filesystem? + (lambda (exn) + (setup-printf + "WARNING" + "error deleteing file: ~a" + (exn-message exn)))]) + (delete-file f))) + + (define (clean-previous-delete-failures lib-dir path->relative-string/*) + (when (and (eq? 'windows (system-type)) + (directory-exists? lib-dir)) + (for ([f (in-list (directory-list lib-dir))]) + (define bstr (path-element->bytes f)) + (when (equal? (subbytes bstr 0 (min (bytes-length setup-delete-prefix) + (bytes-length bstr))) + setup-delete-prefix) + (define p (build-path lib-dir f)) + (setup-printf "deleting" (path->relative-string/* p)) + (try-delete-file (build-path lib-dir f)))))) + ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Package-dependency checking ;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;