01/02: git: 'update-cached-checkout' gracefully handles missing starting commit.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 1fd7de45f218ce572a3fe87764ad15927e3dbdc4
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sun Jun 7 22:14:56 2020 +0200

    git: 'update-cached-checkout' gracefully handles missing starting commit.
    
    Fixes <https://bugs.gnu.org/41604>
    Reported by John Soo <jsoo1@asu.edu> and zimoun <zimon.toutoune@gmail.com>.
    
    * guix/git.scm (false-if-git-not-found): New macro.
    (reference-available?): Use it.
    (update-cached-checkout): Use it when looking up STARTING-COMMIT.
    Set RELATION to 'unrelated when OLD is #false.
---
 guix/git.scm | 28 ++++++++++++++++++----------
 1 file changed, 18 insertions(+), 10 deletions(-)

diff --git a/guix/git.scm b/guix/git.scm
index ab3b507..1c45afa 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -243,18 +243,23 @@ Return true on success, false on failure."
               (G_ "Support for submodules is missing; \
 please upgrade Guile-Git.~%"))))
 
+(define-syntax-rule (false-if-git-not-found exp)
+  "Evaluate EXP, returning #false if a GIT_ENOTFOUND error is raised."
+  (catch 'git-error
+    (lambda ()
+      exp)
+    (lambda (key error . rest)
+      (if (= GIT_ENOTFOUND (git-error-code error))
+          #f
+          (apply throw key error rest)))))
+
 (define (reference-available? repository ref)
   "Return true if REF, a reference such as '(commit . \"cabba9e\"), is
 definitely available in REPOSITORY, false otherwise."
   (match ref
     (('commit . commit)
-     (catch 'git-error
-       (lambda ()
-         (->bool (commit-lookup repository (string->oid commit))))
-       (lambda (key error . rest)
-         (if (= GIT_ENOTFOUND (git-error-code error))
-             #f
-             (apply throw key error rest)))))
+     (false-if-git-not-found
+      (->bool (commit-lookup repository (string->oid commit)))))
     (_
      #f)))
 
@@ -311,10 +316,13 @@ When RECURSIVE? is true, check out submodules as well, if 
any."
             (new      (and starting-commit
                            (commit-lookup repository oid)))
             (old      (and starting-commit
-                           (commit-lookup repository
-                                          (string->oid starting-commit))))
+                           (false-if-git-not-found
+                            (commit-lookup repository
+                                           (string->oid starting-commit)))))
             (relation (and starting-commit
-                           (commit-relation old new))))
+                           (if old
+                               (commit-relation old new)
+                               'unrelated))))
 
        ;; Reclaim file descriptors and memory mappings associated with
        ;; REPOSITORY as soon as possible.