M guix/scripts/gc.scm => guix/scripts/gc.scm +1 -1
@@ 168,7 168,7 @@ Invoke the garbage collector.\n"))
(collect-garbage store min-freed)
(collect-garbage store))))
((delete)
- (delete-paths store paths))
+ (delete-paths store (map direct-store-path paths)))
((list-references)
(list-relatives references))
((list-requisites)
M guix/store.scm => guix/store.scm +10 -0
@@ 121,6 121,7 @@
derivation-path?
store-path-package-name
store-path-hash-part
+ direct-store-path
log-file))
(define %protocol-version #x10c)
@@ 1012,6 1013,15 @@ valid inputs."
(let ((len (+ 1 (string-length (%store-prefix)))))
(not (string-index (substring path len) #\/)))))
+(define (direct-store-path path)
+ "Return the direct store path part of PATH, stripping components after
+'/gnu/store/xxxx-foo'."
+ (let ((prefix-length (+ (string-length (%store-prefix)) 35)))
+ (if (> (string-length path) prefix-length)
+ (let ((slash (string-index path #\/ prefix-length)))
+ (if slash (string-take path slash) path))
+ path)))
+
(define (derivation-path? path)
"Return #t if PATH is a derivation path."
(and (store-path? path) (string-suffix? ".drv" path)))
M tests/guix-gc.sh => tests/guix-gc.sh +20 -0
@@ 64,3 64,23 @@ guix gc -C 1KiB
# Check trivial error cases.
if guix gc --delete /dev/null;
then false; else true; fi
+
+# Bug #19757
+out="`guix build guile-bootstrap`"
+test -d "$out"
+
+guix gc --delete "$out"
+
+! test -d "$out"
+
+out="`guix build guile-bootstrap`"
+test -d "$out"
+
+guix gc --delete "$out/"
+
+! test -d "$out"
+
+out="`guix build guile-bootstrap`"
+test -d "$out"
+
+guix gc --delete "$out/bin/guile"