kreyren/guix-kreyren
1
0
Fork 0
Code Issues 1 Pull Requests 1 Releases Activity

gc: ignore trailing slash or subdirectories for `guix gc -d'

Browse Source 
Fixes <http://bugs.gnu.org/19757>.

* guix/scripts/gc.scm (guix-gc): Convert paths to direct store paths.
* guix/store.scm (direct-store-path): Get rid of subdirectories in store path.
* tests/guix-gc.sh: New tests.

Co-authored-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Cyrill Schenkel 2015-05-24 14:04:15 +02:00 committed by Ludovic Courtès
parent 9aafbc0c13
commit cdb5b075d5
3 changed files with 31 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
guix/scripts/gc.scm
View File

@ -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)

10
guix/store.scm
View File

@ -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)))

20
tests/guix-gc.sh
View File

@ -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"