[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
bug#19757: [PATCH] gc: ignore trailing slash or subdirectories for `guix
From: |
Cyrill Schenkel |
Subject: |
bug#19757: [PATCH] gc: ignore trailing slash or subdirectories for `guix gc -d' |
Date: |
Sun, 24 May 2015 14:04:15 +0200 |
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/24.4.50 (gnu/linux) |
>From 7385c2ddd4ca50cb80afcd315287eaadff4d8421 Mon Sep 17 00:00:00 2001
From: Cyrill Schenkel <address@hidden>
Date: Sun, 24 May 2015 13:46:37 +0200
Subject: [PATCH] gc: ignore trailing slash or subdirectories for `guix gc -d'
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.
---
guix/scripts/gc.scm | 2 +-
guix/store.scm | 7 +++++++
tests/guix-gc.sh | 20 ++++++++++++++++++++
3 files changed, 28 insertions(+), 1 deletion(-)
diff --git a/guix/scripts/gc.scm b/guix/scripts/gc.scm
index 4bae65a..a250cdc 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 fc2f8d9..98b293b 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)
@@ -1038,6 +1039,12 @@ syntactically valid store path."
(and=> (regexp-exec path-rx path)
(cut match:substring <> 1))))
+(define (direct-store-path path)
+ "Return the direct store path part of PATH."
+ (let* ((minimal-prefix-length (+ (string-length (%store-prefix)) 35))
+ (slash-index (string-index path #\/ minimal-prefix-length)))
+ (if slash-index (string-take path slash-index) path)))
+
(define (log-file store file)
"Return the build log file for FILE, or #f if none could be found. FILE
must be an absolute store file name, or a derivation file name."
diff --git a/tests/guix-gc.sh b/tests/guix-gc.sh
index eac9d82..c1eb66c 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"
--
2.1.4
- bug#19757: [PATCH] gc: ignore trailing slash or subdirectories for `guix gc -d',
Cyrill Schenkel <=