[bug#41425] [PATCH 1/5] git: Add 'commit-relation'.

[Ludovic Courtès]

* guix/git.scm (commit-relation): New procedure.
* tests/git.scm ("commit-relation"): New test.
---
 guix/git.scm  | 16 ++++++++++++++++
 tests/git.scm | 42 +++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 57 insertions(+), 1 deletion(-)

diff --git a/guix/git.scm b/guix/git.scm
index 92121156cf..249d622756 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -43,6 +43,7 @@
             url+commit->name
             latest-repository-commit
             commit-difference
+            commit-relation
 
             git-checkout
             git-checkout?
@@ -405,6 +406,21 @@ that of OLD."
                  (cons head result)
                  (set-insert head visited)))))))
 
+(define (commit-relation 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))))))
+
 
 ;;;
 ;;; Checkouts.
diff --git a/tests/git.scm b/tests/git.scm
index 052f8a79c4..4a806abcc3 100644
--- a/tests/git.scm
+++ b/tests/git.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2019 Ludovic Courtès <address@hidden>
+;;; Copyright © 2019, 2020 Ludovic Courtès <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -122,4 +122,44 @@
              (lset= eq? (commit-difference commit4 commit1 (list commit5))
                     (list commit2 commit3 commit4)))))))
 
+(unless (which (git-command)) (test-skip 1))
+(test-equal "commit-relation"
+  '(self                                          ;master3 master3
+    ancestor                                      ;master1 master3
+    descendant                                    ;master3 master1
+    unrelated                                     ;master2 branch1
+    unrelated                                     ;branch1 master2
+    ancestor                                      ;branch1 merge
+    descendant                                    ;merge branch1
+    ancestor                                      ;master1 merge
+    descendant)                                   ;merge master1
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "first commit")
+        (branch "hack")
+        (checkout "hack")
+        (add "1.txt" "1")
+        (commit "branch commit")
+        (checkout "master")
+        (add "b.txt" "B")
+        (commit "second commit")
+        (add "c.txt" "C")
+        (commit "third commit")
+        (merge "hack" "merge"))
+    (with-repository directory repository
+      (let ((master1 (find-commit repository "first"))
+            (master2 (find-commit repository "second"))
+            (master3 (find-commit repository "third"))
+            (branch1 (find-commit repository "branch"))
+            (merge   (find-commit repository "merge")))
+        (list (commit-relation master3 master3)
+              (commit-relation master1 master3)
+              (commit-relation master3 master1)
+              (commit-relation master2 branch1)
+              (commit-relation branch1 master2)
+              (commit-relation branch1 merge)
+              (commit-relation merge branch1)
+              (commit-relation master1 merge)
+              (commit-relation merge master1))))))
+
 (test-end "git")
-- 
2.26.2