From mboxrd@z Thu Jan 1 00:00:00 1970 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 Message-ID: <87y4kekwqo.fsf_-_@SIRIUS11.sirius11> References: <20150202233426.GA28580@venom.fritz.box> <87wq3yogrj.fsf@gnu.org> <20150225202445.GA10407@venom> Mime-Version: 1.0 Content-Type: text/x-patch Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:46608) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YwZTU-0000L2-PP for bug-guix@gnu.org; Sun, 24 May 2015 13:14:12 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1YwZTP-00051q-OE for bug-guix@gnu.org; Sun, 24 May 2015 13:14:08 -0400 Received: from debbugs.gnu.org ([140.186.70.43]:44953) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YwZTP-00051m-LU for bug-guix@gnu.org; Sun, 24 May 2015 13:14:03 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.80) (envelope-from ) id 1YwZTO-0001Fq-RI for bug-guix@gnu.org; Sun, 24 May 2015 13:14:02 -0400 Sender: "Debbugs-submit" Resent-Message-ID: In-Reply-To: <20150225202445.GA10407@venom> ("=?UTF-8?Q?Tom=C3=A1=C5=A1_?= =?UTF-8?Q?=C4=8Cech?="'s message of "Wed, 25 Feb 2015 21:24:45 +0100") Content-Disposition: inline; filename=0001-gc-ignore-trailing-slash-or-subdirectories-for-guix-.patch List-Id: Bug reports for GNU Guix List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-guix-bounces+gcggb-bug-guix=m.gmane.org@gnu.org Sender: bug-guix-bounces+gcggb-bug-guix=m.gmane.org@gnu.org To: 19757@debbugs.gnu.org >From 7385c2ddd4ca50cb80afcd315287eaadff4d8421 Mon Sep 17 00:00:00 2001 From: Cyrill Schenkel Date: Sun, 24 May 2015 13:46:37 +0200 Subject: [PATCH] gc: ignore trailing slash or subdirectories for `guix gc -d' Fixes . * 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