git: Use ‘graph-descendant?’ from Guile-Git >= 0.10.0 when available.

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 happens when the commit’s metadata is
beyond 4 KiB at least 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 (git graph) is available,
rewrite in terms of ‘graph-descendant?’.
(commit-descendant?): Likewise.

Change-Id: Ie52b188a8dfa90c95a73387c3ab2fdd04d2bf3e9
Reported-by: Tomas Volf <~@wolfsden.cz>

guix/git.scm

@@ -732,7 +732,7 @@ Log progress and checkout info to LOG-PORT."
 ;;; 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,10 +768,23 @@ that of OLD."
                  (cons head result)
                  (set-insert head visited)))))))
 
-(define (commit-relation old new)
+(define commit-relation
+  (if (resolve-module '(git 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)."
+        (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)))
@@ -781,13 +794,21 @@ objects: 'ancestor (meaning that OLD is an ancestor of NEW), 'descendant, or
                          (oldest (commit-closure old seen)))
                     (if (set-contains? oldest new)
                         'descendant
-                  'unrelated))))))
+                        'unrelated))))))))
 
-(define (commit-descendant? new old)
+(define commit-descendant?
-  "Return true if NEW is the descendant of one of OLD, a list of commits.
+  (if (resolve-module '(git graph) #:ensure #f)   ;Guile-Git >= 0.10.0
-
+      (lambda (new old)
-When the expected result is likely #t, this is faster than using
+        "Return true if NEW is the descendant of one of OLD, a list of
-'commit-relation' since fewer commits need to be traversed."
+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)))
@@ -800,7 +821,7 @@ When the expected result is likely #t, this is faster than using
                (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)))))))))
+                           (fold set-insert visited commits)))))))))))
 
 
 ;;