store: Invalidate caches once GC has run.
* guix/store.scm (run-gc): Add calls to 'hash-clear!'. * tests/store.scm ("add-text-to-store vs. delete-paths", "add-to-store vs. delete-paths"): New tests.
This commit is contained in:
parent
8de1691475
commit
000c59b671
@ -728,6 +728,13 @@ and the number of bytes freed."
|
||||
(let ((paths (read-store-path-list s))
|
||||
(freed (read-long-long s))
|
||||
(obsolete (read-long-long s)))
|
||||
(unless (null? paths)
|
||||
;; To be on the safe side, completely invalidate both caches.
|
||||
;; Otherwise we could end up returning store paths that are no longer
|
||||
;; valid.
|
||||
(hash-clear! (nix-server-add-to-store-cache server))
|
||||
(hash-clear! (nix-server-add-text-to-store-cache server)))
|
||||
|
||||
(values paths freed))))
|
||||
|
||||
(define-syntax-rule (%long-long-max)
|
||||
|
@ -158,6 +158,31 @@
|
||||
(> freed 0)
|
||||
(not (file-exists? p))))))
|
||||
|
||||
(test-assert "add-text-to-store vs. delete-paths"
|
||||
;; Before, 'add-text-to-store' would return PATH2 without noticing that it
|
||||
;; is no longer valid.
|
||||
(with-store store
|
||||
(let* ((text (random-text))
|
||||
(path (add-text-to-store store "delete-me" text))
|
||||
(deleted (delete-paths store (list path)))
|
||||
(path2 (add-text-to-store store "delete-me" text)))
|
||||
(and (string=? path path2)
|
||||
(equal? deleted (list path))
|
||||
(valid-path? store path)
|
||||
(file-exists? path)))))
|
||||
|
||||
(test-assert "add-to-store vs. delete-paths"
|
||||
;; Same as above.
|
||||
(with-store store
|
||||
(let* ((file (search-path %load-path "guix.scm"))
|
||||
(path (add-to-store store "delete-me" #t "sha256" file))
|
||||
(deleted (delete-paths store (list path)))
|
||||
(path2 (add-to-store store "delete-me" #t "sha256" file)))
|
||||
(and (string=? path path2)
|
||||
(equal? deleted (list path))
|
||||
(valid-path? store path)
|
||||
(file-exists? path)))))
|
||||
|
||||
(test-assert "references"
|
||||
(let* ((t1 (add-text-to-store %store "random1"
|
||||
(random-text)))
|
||||
|
Loading…
Reference in New Issue
Block a user