GNU bug report logs - #77875
[PATCH 0/2] Use 'graph-descendant?' from Guile-Git instead of custom code

Previous Next

Full log

Message #8 received at 77875 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 77875 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>,
 Tomas Volf <~@wolfsden.cz>
Subject: [PATCH 1/2] git: Use ‘graph-descendant?’ from Guile-Git >= 0.10.0 when available.
Date: Thu, 17 Apr 2025 22:22:36 +0200

Fixes <https://issues.guix.gnu.org/66268>.

Fixes a bug whereby ‘commit-relation’ and ‘commit-descendant?’ would
provide an incorrect result when two distinct <commit> objects would
exist for the same commit, which can happen when the commit’s metadata
is beyond 4 KiB, as of libgit2 1.8/1.9.

This, in turn, would lead ‘guix pull’ & co. to wrongfully report an
attempt to downgrade and pull to an unrelated commit.

* guix/git.scm (commit-relation): When (guix graph) is available,
rewrite in terms of ‘graph-descendant?’.
(commit-descendant?): Likewise.

Change-Id: Ie52b188a8dfa90c95a73387c3ab2fdd04d2bf3e9
Reported-by: Tomas Volf <~@wolfsden.cz>
---
 guix/git.scm | 83 ++++++++++++++++++++++++++++++++--------------------
 1 file changed, 52 insertions(+), 31 deletions(-)

diff --git a/guix/git.scm b/guix/git.scm
index 01e0918588..cb26714d2d 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -732,7 +732,7 @@ (define (print-git-error port key args default-printer)
 ;;; Commit difference.
 ;;;
 
-(define* (commit-closure commit #:optional (visited (setq)))
+(define* (commit-closure commit #:optional (visited (setq))) ;to remove
   "Return the closure of COMMIT as a set.  Skip commits contained in VISITED,
 a set, and adjoin VISITED to the result."
   (let loop ((commits (list commit))
@@ -768,39 +768,60 @@ (define* (commit-difference new old #:optional (excluded '()))
                  (cons head result)
                  (set-insert head visited)))))))
 
-(define (commit-relation old new)
-  "Return a symbol denoting the relation between OLD and NEW, two commit
+(define commit-relation
+  (if (resolve-module '(guix graph) #:ensure #f)  ;Guile-Git >= 0.10.0
+      (lambda (old new)
+        "Return a symbol denoting the relation between OLD and NEW, two commit
 objects: 'ancestor (meaning that OLD is an ancestor of NEW), 'descendant, or
 'unrelated, or 'self (OLD and NEW are the same commit)."
-  (if (eq? old new)
-      'self
-      (let ((newest (commit-closure new)))
-        (if (set-contains? newest old)
-            'ancestor
-            (let* ((seen   (list->setq (commit-parents new)))
-                   (oldest (commit-closure old seen)))
-              (if (set-contains? oldest new)
-                  'descendant
-                  'unrelated))))))
+        (let ((repository (commit-owner old))
+              (old (commit-id old))
+              (new (commit-id new)))
+          (cond ((graph-descendant? repository new old)
+                 'ancestor)
+                ((oid=? old new)
+                 'self)
+                ((graph-descendant? repository old new)
+                 'descendant)
+                (else 'unrelated))))
+      (lambda (old new)            ;remove when Guile-Git 0.10.0 is widespread
+        (if (eq? old new)
+            'self
+            (let ((newest (commit-closure new)))
+              (if (set-contains? newest old)
+                  'ancestor
+                  (let* ((seen   (list->setq (commit-parents new)))
+                         (oldest (commit-closure old seen)))
+                    (if (set-contains? oldest new)
+                        'descendant
+                        'unrelated))))))))
 
-(define (commit-descendant? new old)
-  "Return true if NEW is the descendant of one of OLD, a list of commits.
-
-When the expected result is likely #t, this is faster than using
-'commit-relation' since fewer commits need to be traversed."
-  (let ((old (list->setq old)))
-    (let loop ((commits (list new))
-               (visited (setq)))
-      (match commits
-        (()
-         #f)
-        (_
-         ;; Perform a breadth-first search as this is likely going to
-         ;; terminate more quickly than a depth-first search.
-         (let ((commits (remove (cut set-contains? visited <>) commits)))
-           (or (any (cut set-contains? old <>) commits)
-               (loop (append-map commit-parents commits)
-                     (fold set-insert visited commits)))))))))
+(define commit-descendant?
+  (if (resolve-module '(guix graph) #:ensure #f)  ;Guile-Git >= 0.10.0
+      (lambda (new old)
+        "Return true if NEW is the descendant of one of OLD, a list of
+commits."
+        (let ((repository (commit-owner new))
+              (new (commit-id new)))
+          (any (lambda (old)
+                 (let ((old (commit-id old)))
+                   (or (graph-descendant? repository new old)
+                       (oid=? old new))))
+               old)))
+      (lambda (new old)            ;remove when Guile-Git 0.10.0 is widespread
+        (let ((old (list->setq old)))
+          (let loop ((commits (list new))
+                     (visited (setq)))
+            (match commits
+              (()
+               #f)
+              (_
+               ;; Perform a breadth-first search as this is likely going to
+               ;; terminate more quickly than a depth-first search.
+               (let ((commits (remove (cut set-contains? visited <>) commits)))
+                 (or (any (cut set-contains? old <>) commits)
+                     (loop (append-map commit-parents commits)
+                           (fold set-insert visited commits)))))))))))
 
 
 ;;
-- 
2.49.0

Previous Next

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