From patchwork Thu Mar 31 11:09:55 2022 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: 38247 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 0844727BBEA; Thu, 31 Mar 2022 12:15:12 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,SPF_HELO_PASS,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 7AC5F27BBE9 for ; Thu, 31 Mar 2022 12:15:11 +0100 (BST) Received: from localhost ([::1]:43302 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1nZsli-0006bn-LI for patchwork@mira.cbaines.net; Thu, 31 Mar 2022 07:15:10 -0400 Received: from eggs.gnu.org ([209.51.188.92]:37178) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nZshi-0001e0-KB for guix-patches@gnu.org; Thu, 31 Mar 2022 07:11:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:44129) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nZshi-0003UZ-AK for guix-patches@gnu.org; Thu, 31 Mar 2022 07:11:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1nZshi-0002DX-3a for guix-patches@gnu.org; Thu, 31 Mar 2022 07:11:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#54393] [PATCH v2 1/3] packages: Add 'package-unique-version-prefix'. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 31 Mar 2022 11:11:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 54393 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 54393@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 54393-submit@debbugs.gnu.org id=B54393.16487250428395 (code B ref 54393); Thu, 31 Mar 2022 11:11:02 +0000 Received: (at 54393) by debbugs.gnu.org; 31 Mar 2022 11:10:42 +0000 Received: from localhost ([127.0.0.1]:38018 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nZshB-00029q-Pm for submit@debbugs.gnu.org; Thu, 31 Mar 2022 07:10:42 -0400 Received: from eggs.gnu.org ([209.51.188.92]:48994) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nZsh9-00029W-Qn for 54393@debbugs.gnu.org; Thu, 31 Mar 2022 07:10:28 -0400 Received: from [2001:470:142:3::e] (port=54754 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 ) id 1nZsh0-0003As-Fc; Thu, 31 Mar 2022 07:10:20 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=UnX/f/npe2jrnWpzxE1xCApRW4evuVDDsHpuKcxiCog=; b=H1iYXogn4KfmVoKqshUA p7nUgEh/QfAC1qIaQMz45Iw0WJ8q2SXLCqk0voU7V0NBUMEp15bUIhCDAMwKUHaY3Mp2agD9K2+5c lNsSTQpq1u7U2rbXbajIE+k78sgdlfAr6rcYJD3GvsYHp3HyNFIfcXOBPofBoa2PeHQCCIoSM6mlP lsq6jPUC++Xm4Wad9kJgy4ShiA3OzXkuy/1oW7BJthebcqbGUaY8BkUX04y0LJIKfICZPRgM8XQhl t6TjGY4yoMOe9/EYvxG0SSsJ2aEyKBT50CeTNDBQ96rmXbWF1tixvoALqeEey4V5Dg4QCgTEe1vEg hwC3UJJ7ZazNVQ==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201]:61384 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nZsgu-0002dj-Lx; Thu, 31 Mar 2022 07:10:16 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Thu, 31 Mar 2022 13:09:55 +0200 Message-Id: <20220331110957.31829-1-ludo@gnu.org> X-Mailer: git-send-email 2.34.0 In-Reply-To: <87r173huph.fsf@gnu.org> References: <87r173huph.fsf@gnu.org> 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 * gnu/packages.scm (package-unique-version-prefix): New procedure. * guix/scripts/package.scm (manifest-entry-version-prefix): Use it. * tests/packages.scm ("package-unique-version-prefix, gcc@8") ("package-unique-version-prefix, grep"): New tests. --- gnu/packages.scm | 21 +++++++++++++++++++++ guix/scripts/package.scm | 20 ++------------------ tests/packages.scm | 13 +++++++++++++ 3 files changed, 36 insertions(+), 18 deletions(-) diff --git a/gnu/packages.scm b/gnu/packages.scm index 65ab7a7c1e..2ba838fd0a 100644 --- a/gnu/packages.scm +++ b/gnu/packages.scm @@ -66,6 +66,8 @@ (define-module (gnu packages) specification->location specifications->manifest + package-unique-version-prefix + generate-package-cache)) ;;; Commentary: @@ -559,3 +561,22 @@ (define (specifications->manifest specs) ;; fiddle with multiple-value returns. (packages->manifest (map (compose list specification->package+output) specs))) + +(define (package-unique-version-prefix name version) + "Search among all the versions of package NAME that are available, and +return the shortest unambiguous version prefix to designate VERSION. If only +one version of the package is available, return the empty string." + (match (map package-version (find-packages-by-name name)) + ((_) + ;; A single version of NAME is available, so do not specify the version + ;; number, even if the available version doesn't match VERSION. + "") + (versions + ;; If VERSION is the latest version, don't specify any version. + ;; Otherwise return the shortest unique version prefix. Note that this + ;; is based on the currently available packages so the result may vary + ;; over time. + (if (every (cut version>? version <>) + (delete version versions)) + "" + (version-unique-prefix version versions))))) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 9699c70c6d..22ee8a2485 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -334,24 +334,8 @@ (define (manifest-entry-version-prefix entry) "Search among all the versions of ENTRY's package that are available, and return the shortest unambiguous version prefix for this package. If only one version of ENTRY's package is available, return the empty string." - (let ((name (manifest-entry-name entry))) - (match (map package-version (find-packages-by-name name)) - ((_) - ;; A single version of NAME is available, so do not specify the - ;; version number, even if the available version doesn't match ENTRY. - "") - (versions - ;; If ENTRY uses the latest version, don't specify any version. - ;; Otherwise return the shortest unique version prefix. Note that - ;; this is based on the currently available packages, which could - ;; differ from the packages available in the revision that was used - ;; to build MANIFEST. - (let ((current (manifest-entry-version entry))) - (if (every (cut version>? current <>) - (delete current versions)) - "" - (version-unique-prefix (manifest-entry-version entry) - versions))))))) + (package-unique-version-prefix (manifest-entry-name entry) + (manifest-entry-version entry))) (define* (export-manifest manifest #:optional (port (current-output-port))) diff --git a/tests/packages.scm b/tests/packages.scm index 710eace6dc..6cbc34ba0b 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -1923,6 +1923,19 @@ (define (list->set* lst) (package-location (specification->package "guile@2")) (specification->location "guile@2")) +(test-equal "package-unique-version-prefix, gcc@8" + "8" + (let ((gcc (specification->package "gcc-toolchain@8"))) + (package-unique-version-prefix (package-name gcc) + (package-version gcc)))) + +(test-equal "package-unique-version-prefix, grep" + "" + (let ((grep (specification->package "grep"))) + (package-unique-version-prefix (package-name grep) + (package-version grep)))) + + (test-eq "this-package-input, exists" hello (package-arguments