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

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

[Marius Bakke]

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

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

[Leo Famulari]

[-- Attachment #1: Type: text/plain, Size: 2370 bytes --]

On Sat, Sep 15, 2018 at 12:10:34PM +0200, Marius Bakke wrote:
> 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".

Thanks!

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

To clarify what this fixes, I tried building a fresh worktree from
scratch without your patch and it crashed:

------
  LOAD     gnu/tests/install.scm
Backtrace:
In srfi/srfi-1.scm:
   592:29 19 (map1 (#<<service> type: #<service-type mingetty cf7?> ?))
   592:29 18 (map1 (#<<service> type: #<service-type mingetty cf7?> ?))
   592:29 17 (map1 (#<<service> type: #<service-type mingetty cf7?> ?))
   592:29 16 (map1 (#<<service> type: #<service-type syslog c7537?> ?))
   592:17 15 (map1 (#<<service> type: #<service-type guix 43f8be0?> ?))
In ice-9/eval.scm:
   196:43 14 (_ #(#(#(#<directory (gnu tests install) 110a20a0>) ?) ?))
   293:34 13 (_ #(#(#(#<directory (gnu tests install) 110a20a0>) ?) ?))
   293:34 12 (_ #(#(#(#<directory (gnu packages package-manag?> ?)) ?))
   174:20 11 (_ #(#(#(#<directory (gnu packages package-manag?> ?)) ?))
   177:49 10 (lp (#<procedure ed4d8c0 at ice-9/eval.scm:282:4 (en?> ?))
   177:49  9 (lp (#<procedure ed4d8a0 at ice-9/eval.scm:282:4 (en?> ?))
   177:49  8 (lp (#<procedure ed4d880 at ice-9/eval.scm:282:4 (en?> ?))
   177:32  7 (lp (#<procedure ed4d860 at ice-9/eval.scm:182:7 (env)>))
In unknown file:
           6 (force #<promise #<procedure 8aa6580 at ice-9/eval.scm:?>)
In ice-9/eval.scm:
   293:34  5 (_ #(#(#<directory (gnu packages package-management?> ?)))
In ice-9/boot-9.scm:
    829:9  4 (catch git-error #<procedure ed4d460 at ice-9/eval.scm?> ?)
In ice-9/eval.scm:
   293:34  3 (_ #(#(#<directory (guix git-download) 3ec5c80> "/ho?")))
   293:34  2 (_ #(#(#(#(#(#(#(#(#(#(#(#) ?) ?) ?) ?) ?) ?) ?) ?) ?) ?))
    159:9  1 (_ #(#(#(#(#(#(#(#(#(#(#(#) ?) ?) ?) ?) ?) ?) ?) ?) ?) ?))
In unknown file:
           0 (string-drop "/home/leo/tmp/mytest" 35)

ERROR: In procedure string-drop:
Value out of range 0 to 20: 35
------

Your patch avoids this crash, which I was stymied by a couple days ago!
Has it always been there? I've been using Guix worktrees for a while.

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 833 bytes --]

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

[Ludovic Courtès]

Hello Marius!

Marius Bakke <mbakke@fastmail.com> skribis:

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

I think we can avoid the call to ‘canonicalize-path’ here, can’t we?
It’s costly, and since we did it just above, it shouldn’t be needed
here.

Otherwise LGTM, thank you!

Ludo’.

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

[Ludovic Courtès]

Hi Leo,

Leo Famulari <leo@famulari.name> skribis:

> Your patch avoids this crash, which I was stymied by a couple days ago!
> Has it always been there? I've been using Guix worktrees for a while.

I kindly introduced the bug in
aed0a594058a59bc3bb1d2686391dc0e8a181b1f.  :-)

Ludo’.

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

[Marius Bakke]

[-- Attachment #1.1: Type: text/plain, Size: 1753 bytes --]

ludo@gnu.org (Ludovic Courtès) writes:

> Hello Marius!
>
> Marius Bakke <mbakke@fastmail.com> skribis:
>
>> 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)))
>
> I think we can avoid the call to ‘canonicalize-path’ here, can’t we?
> It’s costly, and since we did it just above, it shouldn’t be needed
> here.

You're right.  I mostly needed it because (repository-working-directory)
includes a trailing slash.  This behaviour seems to be consistent, so I
managed to simplify the code further by assuming that is the case:


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: 0001-git-download-Don-t-assume-the-working-directory-is-t.patch --]
[-- Type: text/x-patch, Size: 2262 bytes --]

From e8b443e1de0a5b1e3dfeee024cd0625790f4f834 Mon Sep 17 00:00:00 2001
From: Marius Bakke <mbakke@fastmail.com>
Date: Sat, 15 Sep 2018 11:53:40 +0200
Subject: [PATCH] git-download: Don't assume the working directory is the
 parent of ".git".

* guix/git-download.scm (git-file-list): Use REPOSITORY-WORKING-DIRECTORY to
locate checkout.  Rename from "top" to "workdir".
---
 guix/git-download.scm | 13 ++++++-------
 1 file changed, 6 insertions(+), 7 deletions(-)

diff --git a/guix/git-download.scm b/guix/git-download.scm
index 24cf11be5..eb20927c7 100644
--- a/guix/git-download.scm
+++ b/guix/git-download.scm
@@ -156,22 +156,21 @@ HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if #f."
 The result is similar to that of the 'git ls-files' command, except that it
 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))
+  (let* ((directory  (string-append (canonicalize-path directory) "/"))
          (dot-git    (repository-discover directory))
-         (top        (dirname dot-git))
          (repository (repository-open dot-git))
+         ;; XXX: This procedure is mistakenly private in Guile-Git 0.1.0.
+         (workdir    ((@@ (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)))
-                         "/")))
+        (let ((relative (string-drop directory (string-length workdir))))
           (filter-map (lambda (file)
                         (and (string-prefix? relative file)
                              (string-drop file (string-length relative))))
-- 
2.19.0


[-- Attachment #1.3: Type: text/plain, Size: 7 bytes --]


WDYT?

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 487 bytes --]

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

[Ludovic Courtès]

Hello!

Marius Bakke <mbakke@fastmail.com> skribis:

> From e8b443e1de0a5b1e3dfeee024cd0625790f4f834 Mon Sep 17 00:00:00 2001
> From: Marius Bakke <mbakke@fastmail.com>
> Date: Sat, 15 Sep 2018 11:53:40 +0200
> Subject: [PATCH] git-download: Don't assume the working directory is the
>  parent of ".git".
>
> * guix/git-download.scm (git-file-list): Use REPOSITORY-WORKING-DIRECTORY to
> locate checkout.  Rename from "top" to "workdir".
> ---
>  guix/git-download.scm | 13 ++++++-------
>  1 file changed, 6 insertions(+), 7 deletions(-)
>
> diff --git a/guix/git-download.scm b/guix/git-download.scm
> index 24cf11be5..eb20927c7 100644
> --- a/guix/git-download.scm
> +++ b/guix/git-download.scm
> @@ -156,22 +156,21 @@ HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if #f."
>  The result is similar to that of the 'git ls-files' command, except that it
>  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))
> +  (let* ((directory  (string-append (canonicalize-path directory) "/"))

Could you just add a comment here explaining that
‘repository-working-directory’ always appends a trailing slash?

Otherwise LGTM, thank you!

Ludo’.

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

[Marius Bakke]

[-- Attachment #1: Type: text/plain, Size: 1501 bytes --]

ludo@gnu.org (Ludovic Courtès) writes:

> Hello!
>
> Marius Bakke <mbakke@fastmail.com> skribis:
>
>> From e8b443e1de0a5b1e3dfeee024cd0625790f4f834 Mon Sep 17 00:00:00 2001
>> From: Marius Bakke <mbakke@fastmail.com>
>> Date: Sat, 15 Sep 2018 11:53:40 +0200
>> Subject: [PATCH] git-download: Don't assume the working directory is the
>>  parent of ".git".
>>
>> * guix/git-download.scm (git-file-list): Use REPOSITORY-WORKING-DIRECTORY to
>> locate checkout.  Rename from "top" to "workdir".
>> ---
>>  guix/git-download.scm | 13 ++++++-------
>>  1 file changed, 6 insertions(+), 7 deletions(-)
>>
>> diff --git a/guix/git-download.scm b/guix/git-download.scm
>> index 24cf11be5..eb20927c7 100644
>> --- a/guix/git-download.scm
>> +++ b/guix/git-download.scm
>> @@ -156,22 +156,21 @@ HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if #f."
>>  The result is similar to that of the 'git ls-files' command, except that it
>>  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))
>> +  (let* ((directory  (string-append (canonicalize-path directory) "/"))
>
> Could you just add a comment here explaining that
> ‘repository-working-directory’ always appends a trailing slash?

Good idea.

> Otherwise LGTM, thank you!

Pushed as 280fc8351230a8fea086d9bbce919ba8395f312c, thanks!

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 487 bytes --]