From patchwork Wed May 20 21:47:21 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 22234 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id A9CE627BBE3; Wed, 20 May 2020 22:48:10 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, RCVD_IN_MSPIKE_H4,RCVD_IN_MSPIKE_WL,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.2 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTP id 625C727BBE1 for ; Wed, 20 May 2020 22:48:10 +0100 (BST) Received: from localhost ([::1]:37824 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jbWZN-0003Q5-SZ for patchwork@mira.cbaines.net; Wed, 20 May 2020 17:48:09 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:51424) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1jbWZG-0003O8-9p for guix-patches@gnu.org; Wed, 20 May 2020 17:48:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:43002) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1jbWZG-0003NE-0g for guix-patches@gnu.org; Wed, 20 May 2020 17:48:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1jbWZF-00063L-Uz for guix-patches@gnu.org; Wed, 20 May 2020 17:48:01 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#41425] [PATCH 1/5] git: Add 'commit-relation'. References: <20200520213802.2170-1-ludo@gnu.org> In-Reply-To: <20200520213802.2170-1-ludo@gnu.org> Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 20 May 2020 21:48:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 41425 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 41425@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 41425-submit@debbugs.gnu.org id=B41425.159001126523201 (code B ref 41425); Wed, 20 May 2020 21:48:01 +0000 Received: (at 41425) by debbugs.gnu.org; 20 May 2020 21:47:45 +0000 Received: from localhost ([127.0.0.1]:54537 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jbWYz-000627-64 for submit@debbugs.gnu.org; Wed, 20 May 2020 17:47:45 -0400 Received: from eggs.gnu.org ([209.51.188.92]:43938) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jbWYw-00061i-U3 for 41425@debbugs.gnu.org; Wed, 20 May 2020 17:47:43 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:59451) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jbWYq-0003L1-E3; Wed, 20 May 2020 17:47:37 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=56656 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1jbWYp-0007cZ-D7; Wed, 20 May 2020 17:47:35 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Wed, 20 May 2020 23:47:21 +0200 Message-Id: <20200520214725.2437-1-ludo@gnu.org> X-Mailer: git-send-email 2.26.2 MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * 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 +;;; Copyright © 2019, 2020 Ludovic Courtès ;;; ;;; 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")