From patchwork Wed Jul 15 23:18:56 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 23240 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 F2E1A27BBE5; Thu, 16 Jul 2020 00:20:11 +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 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 688B727BBE3 for ; Thu, 16 Jul 2020 00:20:10 +0100 (BST) Received: from localhost ([::1]:57482 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jvqh7-0003vc-PN for patchwork@mira.cbaines.net; Wed, 15 Jul 2020 19:20:09 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:36486) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1jvqh0-0003ue-K9 for guix-patches@gnu.org; Wed, 15 Jul 2020 19:20:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:42442) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1jvqh0-00033W-AT for guix-patches@gnu.org; Wed, 15 Jul 2020 19:20:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1jvqh0-0007IP-5u for guix-patches@gnu.org; Wed, 15 Jul 2020 19:20:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#42381] [PATCH 1/3] git: Factorize 'resolve-reference'. References: <20200715221506.8468-1-ludo@gnu.org> In-Reply-To: <20200715221506.8468-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, 15 Jul 2020 23:20:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 42381 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 42381@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 42381-submit@debbugs.gnu.org id=B42381.159485516527984 (code B ref 42381); Wed, 15 Jul 2020 23:20:02 +0000 Received: (at 42381) by debbugs.gnu.org; 15 Jul 2020 23:19:25 +0000 Received: from localhost ([127.0.0.1]:53984 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jvqgP-0007HH-0N for submit@debbugs.gnu.org; Wed, 15 Jul 2020 19:19:25 -0400 Received: from eggs.gnu.org ([209.51.188.92]:50770) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jvqgL-0007Gp-Gh for 42381@debbugs.gnu.org; Wed, 15 Jul 2020 19:19:24 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:38493) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jvqgF-0002ue-Gn; Wed, 15 Jul 2020 19:19:15 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=49700 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1jvqgF-0002z2-2w; Wed, 15 Jul 2020 19:19:15 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Thu, 16 Jul 2020 01:18:56 +0200 Message-Id: <20200715231858.10201-1-ludo@gnu.org> X-Mailer: git-send-email 2.27.0 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 (resolve-reference): New procedure. (switch-to-ref): Use it. --- guix/git.scm | 79 ++++++++++++++++++++++++++++------------------------ 1 file changed, 42 insertions(+), 37 deletions(-) diff --git a/guix/git.scm b/guix/git.scm index 19c1cb59d3..ca67b1d37c 100644 --- a/guix/git.scm +++ b/guix/git.scm @@ -150,47 +150,52 @@ of SHA1 string." (last (string-split url #\/)) ".git" "") "-" (string-take sha1 7))) +(define (resolve-reference repository ref) + "Resolve the branch, commit or tag specified by REF, and return the +corresponding Git object." + (let resolve ((ref ref)) + (match ref + (('branch . branch) + (let ((oid (reference-target + (branch-lookup repository branch BRANCH-REMOTE)))) + (object-lookup repository oid))) + (('commit . commit) + (let ((len (string-length commit))) + ;; 'object-lookup-prefix' appeared in Guile-Git in Mar. 2018, so we + ;; can't be sure it's available. Furthermore, 'string->oid' used to + ;; read out-of-bounds when passed a string shorter than 40 chars, + ;; which is why we delay calls to it below. + (if (< len 40) + (if (module-defined? (resolve-interface '(git object)) + 'object-lookup-prefix) + (object-lookup-prefix repository (string->oid commit) len) + (raise (condition + (&message + (message "long Git object ID is required"))))) + (object-lookup repository (string->oid commit))))) + (('tag-or-commit . str) + (if (or (> (string-length str) 40) + (not (string-every char-set:hex-digit str))) + (resolve `(tag . ,str)) ;definitely a tag + (catch 'git-error + (lambda () + (resolve `(tag . ,str))) + (lambda _ + ;; There's no such tag, so it must be a commit ID. + (resolve `(commit . ,str)))))) + (('tag . tag) + (let ((oid (reference-name->oid repository + (string-append "refs/tags/" tag)))) + ;; OID may point to a "tag" object, but it can also point directly + ;; to a "commit" object, as surprising as it may seem. Return that + ;; object, whatever that is. + (object-lookup repository oid)))))) + (define (switch-to-ref repository ref) "Switch to REPOSITORY's branch, commit or tag specified by REF. Return the OID (roughly the commit hash) corresponding to REF." (define obj - (let resolve ((ref ref)) - (match ref - (('branch . branch) - (let ((oid (reference-target - (branch-lookup repository branch BRANCH-REMOTE)))) - (object-lookup repository oid))) - (('commit . commit) - (let ((len (string-length commit))) - ;; 'object-lookup-prefix' appeared in Guile-Git in Mar. 2018, so we - ;; can't be sure it's available. Furthermore, 'string->oid' used to - ;; read out-of-bounds when passed a string shorter than 40 chars, - ;; which is why we delay calls to it below. - (if (< len 40) - (if (module-defined? (resolve-interface '(git object)) - 'object-lookup-prefix) - (object-lookup-prefix repository (string->oid commit) len) - (raise (condition - (&message - (message "long Git object ID is required"))))) - (object-lookup repository (string->oid commit))))) - (('tag-or-commit . str) - (if (or (> (string-length str) 40) - (not (string-every char-set:hex-digit str))) - (resolve `(tag . ,str)) ;definitely a tag - (catch 'git-error - (lambda () - (resolve `(tag . ,str))) - (lambda _ - ;; There's no such tag, so it must be a commit ID. - (resolve `(commit . ,str)))))) - (('tag . tag) - (let ((oid (reference-name->oid repository - (string-append "refs/tags/" tag)))) - ;; OID may point to a "tag" object, but it can also point directly - ;; to a "commit" object, as surprising as it may seem. Return that - ;; object, whatever that is. - (object-lookup repository oid)))))) + (resolve-reference repository ref)) (reset repository obj RESET_HARD) (object-id obj))