git: Add 'commit-relation'.
* guix/git.scm (commit-relation): New procedure. * tests/git.scm ("commit-relation"): New test.
This commit is contained in:
parent
86ac14b2f3
commit
c098c11be8
16
guix/git.scm
16
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.
|
||||
|
@ -1,5 +1,5 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
|
||||
;;;
|
||||
;;; 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")
|
||||
|
Loading…
Reference in New Issue
Block a user