diff options
-rw-r--r-- | guix/scripts/gc.scm | 2 | ||||
-rw-r--r-- | guix/store.scm | 10 | ||||
-rw-r--r-- | tests/guix-gc.sh | 20 |
3 files changed, 31 insertions, 1 deletions
diff --git a/guix/scripts/gc.scm b/guix/scripts/gc.scm index 4bae65a1ec..a250cdc197 100644 --- a/guix/scripts/gc.scm +++ b/guix/scripts/gc.scm @@ -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) diff --git a/guix/store.scm b/guix/store.scm index fc2f8d92ca..8905a5a558 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -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))) diff --git a/tests/guix-gc.sh b/tests/guix-gc.sh index eac9d82e89..c1eb66cef5 100644 --- a/tests/guix-gc.sh +++ b/tests/guix-gc.sh @@ -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" |