GNU bug report logs - #32740
[PATCH] git-download: Don't assume the git checkout is the parent of ".git".

Previous Next

Full log

View this message in rfc822 format

From: Marius Bakke <mbakke <at> fastmail.com>
To: 32740 <at> debbugs.gnu.org
Subject: [bug#32740] [PATCH] git-download: Don't assume the git checkout is the parent of ".git".
Date: Sat, 15 Sep 2018 12:10:34 +0200

This makes it play nicely with worktrees.

* guix/git-download.scm (git-file-list): Use REPOSITORY-WORKING-DIRECTORY to
locate checkout.  Rename from "top" to "workdir".
---

Notes:
    Guix,
    
    This fixes (current-guix) for me in a worktree.  Testing needed on other git
    setups!

 guix/git-download.scm | 9 ++++++---
 1 file changed, 6 insertions(+), 3 deletions(-)

diff --git a/guix/git-download.scm b/guix/git-download.scm
index 24cf11be5..a7c8173f4 100644
--- a/guix/git-download.scm
+++ b/guix/git-download.scm
@@ -158,19 +158,22 @@ also includes directories, not just regular files.  The returned file names
 are relative to DIRECTORY, which is not necessarily the root of the checkout."
   (let* ((directory  (canonicalize-path directory))
          (dot-git    (repository-discover directory))
-         (top        (dirname dot-git))
          (repository (repository-open dot-git))
+         (workdir    (canonicalize-path
+                      ;; XXX: This variable is mistakenly private in Guile-Git 0.1.0.
+                      ((@@ (git repository) repository-working-directory)
+                       repository)))
          (head       (repository-head repository))
          (oid        (reference-target head))
          (commit     (commit-lookup repository oid))
          (tree       (commit-tree commit))
          (files      (tree-list tree)))
     (repository-close! repository)
-    (if (string=? top directory)
+    (if (string=? workdir directory)
         files
         (let ((relative (string-append
                          (string-drop directory
-                                      (+ 1 (string-length top)))
+                                      (+ 1 (string-length workdir)))
                          "/")))
           (filter-map (lambda (file)
                         (and (string-prefix? relative file)
-- 
2.19.0

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.