#53608 [PATCH 0/2] Rejecting commits unrelated to the introductory commit

Message #8 received at 53608@debbugs.gnu.org (full text, mbox, reply):

Received: (at 53608) by debbugs.gnu.org; 28 Jan 2022 17:43:28 +0000
From debbugs-submit-bounces@debbugs.gnu.org Fri Jan 28 12:43:28 2022
Received: from localhost ([127.0.0.1]:60425 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces@debbugs.gnu.org>)
	id 1nDVHU-0001BU-4C
	for submit@debbugs.gnu.org; Fri, 28 Jan 2022 12:43:28 -0500
Received: from eggs.gnu.org ([209.51.188.92]:33924)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <ludo@gnu.org>) id 1nDVHS-0001B9-9L
 for 53608@debbugs.gnu.org; Fri, 28 Jan 2022 12:43:26 -0500
Received: from [2001:470:142:3::e] (port=33974 helo=fencepost.gnu.org)
 by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.90_1) (envelope-from <ludo@gnu.org>)
 id 1nDVHH-0001Xj-WB; Fri, 28 Jan 2022 12:43:19 -0500
DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org;
 s=fencepost-gnu-org; h=MIME-Version:Date:Subject:To:From:in-reply-to:
 references; bh=keTnlh4PjmKHkmyLkF5P2cbYzw/gceW7Tj9wAidp2hA=; b=FbyAP0rtJCBRBX
 MGPaScgbTcyZ9+PikHnLbLkIMvA9lweF0aebUknY4lfiF158VahRmpwDrnuETheHVBbsObH8ZDNSl
 vDecFyrP2y2YOy5PhYQec8OFz9j8asFcjivt6ZTvRtw2FOdlV4q5qZiQnaDuDOxyIuiPVK0LqV4K0
 bq6B6HkI4W4jlYYFHkKwsdrU6C62QCQhNRTcx8ksrGwlybouxmnKReErN094uLuNaxqqnd+xKFbpr
 ENTSdR/B2jV3pP/DyMFUVegJlGuCOOpYo5L4AiU+UVPLh8Io8kxT/U7WkI4UidjQGOR1bb3KG8Tsq
 yHJZJJXItV0vv0qWLeWw==;
Received: from [2001:660:6102:320:e120:2c8f:8909:cdfe] (port=33810
 helo=gnu.org)
 by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128)
 (Exim 4.90_1) (envelope-from <ludo@gnu.org>)
 id 1nDVHC-0002VO-Qf; Fri, 28 Jan 2022 12:43:13 -0500
From: Ludovic Courtès <ludo@gnu.org>
To: 53608@debbugs.gnu.org
Subject: [PATCH 1/2] git: Add 'commit-descendant?'.
Date: Fri, 28 Jan 2022 18:43:00 +0100
Message-Id: <20220128174301.7632-1-ludo@gnu.org>
X-Mailer: git-send-email 2.34.0
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
X-Spam-Score: -0.3 (/)
X-Debbugs-Envelope-To: 53608
Cc: Ludovic Courtès <ludo@gnu.org>
X-BeenThere: debbugs-submit@debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request@debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit@debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request@debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request@debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces@debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces@debbugs.gnu.org>
X-Spam-Score: -1.3 (-)

* 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)))))))))
+
 
 ;;
 ;;; 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

Send a report that this bug log contains spam.