summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2022-01-28 16:59:30 +0100
committerLudovic Courtès <ludo@gnu.org>2022-02-14 11:23:07 +0100
commit87d49346f3072f7b4343b6fb387ee5f9311493b7 (patch)
tree3d232980d2ff6e8276a5c698568d7429cbbf6ef3 /guix
parent36cb04df96623ffe8f1074172a4ed9e51bcf6e3a (diff)
git: Add 'commit-descendant?'.
* guix/git.scm (commit-descendant?): New procedure. * tests/git.scm ("commit-descendant?"): New test.
Diffstat (limited to 'guix')
-rw-r--r--guix/git.scm24
1 files changed, 23 insertions, 1 deletions
diff --git a/guix/git.scm b/guix/git.scm
index 43e85a5026..53e7219c8c 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
-;;; Copyright © 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018-2022 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2021 Kyle Meyer <kyle@kyleam.com>
;;; Copyright © 2021 Marius Bakke <marius@gnu.org>
;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
@@ -46,6 +46,7 @@
#:use-module (ice-9 ftw)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
+ #:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:export (%repository-cache-directory
@@ -60,6 +61,7 @@
latest-repository-commit
commit-difference
commit-relation
+ commit-descendant?
remote-refs
@@ -623,6 +625,26 @@ objects: 'ancestor (meaning that OLD is an ancestor of NEW), 'descendant, or
(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)))))))))
+
;;
;;; Remote operations.