From: "Ludovic Courtès" <ludo@gnu.org>
To: 53608@debbugs.gnu.org
Cc: "Ludovic Courtès" <ludo@gnu.org>
Subject: [bug#53608] [PATCH 1/2] git: Add 'commit-descendant?'.
Date: Fri, 28 Jan 2022 18:43:00 +0100 [thread overview]
Message-ID: <20220128174301.7632-1-ludo@gnu.org> (raw)
In-Reply-To: <20220128173142.7072-1-ludo@gnu.org>
* guix/git.scm (commit-descendant?): New procedure.
* tests/git.scm ("commit-descendant?"): New test.
---
guix/git.scm | 24 +++++++++++++++++++++++-
tests/git.scm | 52 ++++++++++++++++++++++++++++++++++++++++++++++++++-
2 files changed, 74 insertions(+), 2 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 @@ (define-module (guix git)
#: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 @@ (define-module (guix git)
latest-repository-commit
commit-difference
commit-relation
+ commit-descendant?
remote-refs
@@ -623,6 +625,26 @@ (define (commit-relation old new)
(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)))))))))
+
\f
;;
;;; Remote operations.
diff --git a/tests/git.scm b/tests/git.scm
index d0646bbc85..ca59d2a33e 100644
--- a/tests/git.scm
+++ b/tests/git.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz
;;;
;;; This file is part of GNU Guix.
@@ -162,6 +162,56 @@ (define-module (test-git)
(commit-relation master1 merge)
(commit-relation merge master1))))))
+(unless (which (git-command)) (test-skip 1))
+(test-equal "commit-descendant?"
+ '((master3 master3 => #t)
+ (master1 master3 => #f)
+ (master3 master1 => #t)
+ (master2 branch1 => #f)
+ (master2 branch1 master1 => #t)
+ (branch1 master2 => #f)
+ (branch1 merge => #f)
+ (merge branch1 => #t)
+ (master1 merge => #f)
+ (merge master1 => #t))
+ (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")))
+ (letrec-syntax ((verify
+ (syntax-rules ()
+ ((_) '())
+ ((_ (new old ...) rest ...)
+ (cons `(new old ... =>
+ ,(commit-descendant? new
+ (list old ...)))
+ (verify rest ...))))))
+ (verify (master3 master3)
+ (master1 master3)
+ (master3 master1)
+ (master2 branch1)
+ (master2 branch1 master1)
+ (branch1 master2)
+ (branch1 merge)
+ (merge branch1)
+ (master1 merge)
+ (merge master1)))))))
+
(unless (which (git-command)) (test-skip 1))
(test-equal "remote-refs"
'("refs/heads/develop" "refs/heads/master"
--
2.34.0
next prev parent reply other threads:[~2022-01-28 17:49 UTC|newest]
Thread overview: 6+ messages / expand[flat|nested] mbox.gz Atom feed top
2022-01-28 17:31 [bug#53608] [PATCH 0/2] Rejecting commits unrelated to the introductory commit Ludovic Courtès
2022-01-28 17:43 ` Ludovic Courtès [this message]
2022-01-28 17:43 ` [bug#53608] [PATCH 2/2] git-authenticate: Ensure the target is a descendant of " Ludovic Courtès
2022-02-08 23:02 ` [bug#53608] [PATCH 0/2] Rejecting commits unrelated to " Ludovic Courtès
2022-02-10 22:29 ` Maxime Devos
2022-02-14 10:33 ` Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20220128174301.7632-1-ludo@gnu.org \
--to=ludo@gnu.org \
--cc=53608@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.