From patchwork Thu May 18 15:16:09 2023 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: 50118 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 2371827BBE2; Thu, 18 May 2023 16:18:26 +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=-3.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H2,SPF_HELO_PASS, URIBL_BLOCKED autolearn=ham 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 99F2517A72 for ; Thu, 18 May 2023 16:18:24 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pzfNq-0003n6-4l; Thu, 18 May 2023 11:17:38 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pzfNN-0003KQ-Tw for guix-patches@gnu.org; Thu, 18 May 2023 11:17:11 -0400 Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1pzfNK-0001yh-9h for guix-patches@gnu.org; Thu, 18 May 2023 11:17:07 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pzfNF-0005TT-Up; Thu, 18 May 2023 11:17:01 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#63571] [PATCH 01/14] tests: pypi: Factorize tarball and wheel file creation. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: lars@6xq.net, jgart@dismail.de, guix-patches@gnu.org Resent-Date: Thu, 18 May 2023 15:17:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 63571 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 63571@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= , Lars-Dominik Braun , jgart X-Debbugs-Original-Xcc: Lars-Dominik Braun , jgart Received: via spool by 63571-submit@debbugs.gnu.org id=B63571.168442300620917 (code B ref 63571); Thu, 18 May 2023 15:17:01 +0000 Received: (at 63571) by debbugs.gnu.org; 18 May 2023 15:16:46 +0000 Received: from localhost ([127.0.0.1]:54100 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pzfMy-0005R1-Dv for submit@debbugs.gnu.org; Thu, 18 May 2023 11:16:45 -0400 Received: from eggs.gnu.org ([209.51.188.92]:36032) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pzfMt-0005QH-Tn for 63571@debbugs.gnu.org; Thu, 18 May 2023 11:16:42 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pzfMn-0001u5-VO; Thu, 18 May 2023 11:16:33 -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=TV5eqNoYHxzAbEd8qPVouhgZPISTlzx4ipu5kBGrYoE=; b=oaGYiyIF5YRX2hjvK/Iw qhVyP3yYPcRdFZf1kl8DgLDmnbcPWwHj4rjJ/ZYGVd50Am9+DUM+EjIubo8KIUF5pPRZ5RtTEaoHi kOnOHOGMC35DkBi5kWd8h+S3q5zogQDWADTKDOz76x0xJuYFN+Dvd0GbxWF/wZl8nwAAeyjazuqhT 6yf4/G4WbtHKtHxkvyZC2eMRRkdTbtXxsJ6kJLg6YWxuMP7xLQVWjvrTaO3+1YfulUuUorT8QlMhr Bezly7q7zsvQ0QP4BtkGNrp4jayYWFcU6sY6H37ZBmfaLZ2kQU/0V0p7HQdpUxKQPKtn8qBaidDon kugvQ8DobPfTxQ==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201] helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pzfMn-0007G6-Ib; Thu, 18 May 2023 11:16:33 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Thu, 18 May 2023 17:16:09 +0200 Message-Id: X-Mailer: git-send-email 2.40.1 In-Reply-To: References: 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-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches * tests/pypi.scm (sample-directory): New variable. (pypi-tarball, wheel-file): New procedures. ("pypi->guix-package, no wheel") ("pypi->guix-package, wheels") ("pypi->guix-package, no usable requirement file.") ("pypi->guix-package, package name contains \"-\" followed by digits"): Use them. --- tests/pypi.scm | 126 ++++++++++++++++++++++++++++++++----------------- 1 file changed, 82 insertions(+), 44 deletions(-) diff --git a/tests/pypi.scm b/tests/pypi.scm index 1ddcc542ff..1c85e6a16f 100644 --- a/tests/pypi.scm +++ b/tests/pypi.scm @@ -28,8 +28,12 @@ (define-module (test-pypi) #:use-module (gcrypt hash) #:use-module (guix tests) #:use-module (guix build-system python) - #:use-module ((guix build utils) #:select (delete-file-recursively which mkdir-p)) + #:use-module ((guix build utils) + #:select (delete-file-recursively + which mkdir-p + with-directory-excursion)) #:use-module ((guix diagnostics) #:select (guix-warning-port)) + #:use-module ((guix build syscalls) #:select (mkdtemp!)) #:use-module (json) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) @@ -131,6 +135,58 @@ (define test-metadata-with-extras-jedi "\ Requires-Dist: pytest (>=3.1.0); extra == 'testing' ") +(define sample-directory + ;; Directory containing tarballs and .whl files for this test. + (let ((template (string-append (or (getenv "TMPDIR") "/tmp") + "/guix-pypi-test-XXXXXX"))) + (mkdtemp! template))) + +(define (pypi-tarball name specs) + "Return a PyPI tarball called NAME suffixed with '.tar.gz' and containing +the files specified in SPECS. Return its file name." + (let ((directory (in-vicinity sample-directory name)) + (tarball (in-vicinity sample-directory (string-append name ".tar.gz")))) + (false-if-exception (delete-file tarball)) + (mkdir-p directory) + (for-each (match-lambda + ((file content) + (mkdir-p (in-vicinity directory (dirname file))) + (call-with-output-file (in-vicinity directory file) + (lambda (port) + (display content port))))) + specs) + (parameterize ((current-output-port (%make-void-port "w0"))) + (system* "tar" "-C" sample-directory "-czvf" tarball + (basename directory))) + (delete-file-recursively directory) + tarball)) + +(define (wheel-file name specs) + "Return a Wheel file called NAME suffixed with '.whl' and containing the +files specified by SPECS. Return its file name." + (let* ((directory (in-vicinity sample-directory + (string-append name ".dist-info"))) + (zip-file (in-vicinity sample-directory + (string-append name ".zip"))) + (whl-file (in-vicinity sample-directory + (string-append name ".whl")))) + (false-if-exception (delete-file whl-file)) + (mkdir-p directory) + (for-each (match-lambda + ((file content) + (mkdir-p (in-vicinity directory (dirname file))) + (call-with-output-file (in-vicinity directory file) + (lambda (port) + (display content port))))) + specs) + ;; zip always adds a "zip" extension to the file it creates, + ;; so we need to rename it. + (with-directory-excursion (dirname directory) + (system* "zip" "-qr" zip-file (basename directory))) + (rename-file zip-file whl-file) + (delete-file-recursively directory) + whl-file)) + (test-begin "pypi") @@ -224,17 +280,13 @@ (define test-metadata-with-extras-jedi "\ (lambda (url file-name) (match url ("https://example.com/foo-1.0.0.tar.gz" - (begin - ;; Unusual requires.txt location should still be found. - (mkdir-p "foo-1.0.0/src/bizarre.egg-info") - (with-output-to-file "foo-1.0.0/src/bizarre.egg-info/requires.txt" - (lambda () - (display test-requires.txt))) - (parameterize ((current-output-port (%make-void-port "rw+"))) - (system* "tar" "czvf" file-name "foo-1.0.0/")) - (delete-file-recursively "foo-1.0.0") + ;; Unusual requires.txt location should still be found. + (let ((tarball (pypi-tarball "foo-1.0.0" + `(("src/bizarre.egg-info/requires.txt" + ,test-requires.txt))))) + (copy-file tarball file-name) (set! test-source-hash - (call-with-input-file file-name port-sha256)))) + (call-with-input-file file-name port-sha256)))) ("https://example.com/foo-1.0.0-py2.py3-none-any.whl" #f) (_ (error "Unexpected URL: " url))))) (mock ((guix http-client) http-fetch @@ -279,28 +331,18 @@ (define test-metadata-with-extras-jedi "\ (lambda (url file-name) (match url ("https://example.com/foo-1.0.0.tar.gz" - (begin - (mkdir-p "foo-1.0.0/foo.egg-info/") - (with-output-to-file "foo-1.0.0/foo.egg-info/requires.txt" - (lambda () - (display "wrong data to make sure we're testing wheels "))) - (parameterize ((current-output-port (%make-void-port "rw+"))) - (system* "tar" "czvf" file-name "foo-1.0.0/")) - (delete-file-recursively "foo-1.0.0") + (let ((tarball (pypi-tarball + "foo-1.0.0" + '(("foo-1.0.0/foo.egg-info/requires.txt" + "wrong data \ +to make sure we're testing wheels"))))) + (copy-file tarball file-name) (set! test-source-hash (call-with-input-file file-name port-sha256)))) ("https://example.com/foo-1.0.0-py2.py3-none-any.whl" - (begin - (mkdir "foo-1.0.0.dist-info") - (with-output-to-file "foo-1.0.0.dist-info/METADATA" - (lambda () - (display test-metadata))) - (let ((zip-file (string-append file-name ".zip"))) - ;; zip always adds a "zip" extension to the file it creates, - ;; so we need to rename it. - (system* "zip" "-q" zip-file "foo-1.0.0.dist-info/METADATA") - (rename-file zip-file file-name)) - (delete-file-recursively "foo-1.0.0.dist-info"))) + (let ((wheel (wheel-file "foo-1.0.0" + `(("METADATA" ,test-metadata))))) + (copy-file wheel file-name))) (_ (error "Unexpected URL: " url))))) (mock ((guix http-client) http-fetch (lambda (url . rest) @@ -342,12 +384,11 @@ (define test-metadata-with-extras-jedi "\ (lambda (url file-name) (match url ("https://example.com/foo-1.0.0.tar.gz" - (mkdir-p "foo-1.0.0/foo.egg-info/") - (parameterize ((current-output-port (%make-void-port "rw+"))) - (system* "tar" "czvf" file-name "foo-1.0.0/")) - (delete-file-recursively "foo-1.0.0") - (set! test-source-hash - (call-with-input-file file-name port-sha256))) + (let ((tarball (pypi-tarball "foo-1.0.0" + '(("foo.egg-info/.empty" ""))))) + (copy-file tarball file-name) + (set! test-source-hash + (call-with-input-file file-name port-sha256)))) ("https://example.com/foo-1.0.0-py2.py3-none-any.whl" #f) (_ (error "Unexpected URL: " url))))) (mock ((guix http-client) http-fetch @@ -388,15 +429,11 @@ (define test-metadata-with-extras-jedi "\ (lambda (url file-name) (match url ("https://example.com/foo-99-1.0.0.tar.gz" - (begin + (let ((tarball (pypi-tarball "foo-99-1.0.0" + `(("src/bizarre.egg-info/requires.txt" + ,test-requires.txt))))) ;; Unusual requires.txt location should still be found. - (mkdir-p "foo-99-1.0.0/src/bizarre.egg-info") - (with-output-to-file "foo-99-1.0.0/src/bizarre.egg-info/requires.txt" - (lambda () - (display test-requires.txt))) - (parameterize ((current-output-port (%make-void-port "rw+"))) - (system* "tar" "czvf" file-name "foo-99-1.0.0/")) - (delete-file-recursively "foo-99-1.0.0") + (copy-file tarball file-name) (set! test-source-hash (call-with-input-file file-name port-sha256)))) ("https://example.com/foo-99-1.0.0-py2.py3-none-any.whl" #f) @@ -434,3 +471,4 @@ (define test-metadata-with-extras-jedi "\ (pk 'fail x #f)))))) (test-end "pypi") +(delete-file-recursively sample-directory) From patchwork Thu May 18 15:16:10 2023 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: 50110 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 F28DC27BBE2; Thu, 18 May 2023 16:17:48 +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=-3.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H2,SPF_HELO_PASS, URIBL_BLOCKED autolearn=ham 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 03CD917A6F for ; Thu, 18 May 2023 16:17:48 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pzfNY-0003Zl-W4; Thu, 18 May 2023 11:17:21 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pzfNG-0003Jv-Sc for guix-patches@gnu.org; Thu, 18 May 2023 11:17:11 -0400 Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1pzfNG-0001y6-Kh for guix-patches@gnu.org; Thu, 18 May 2023 11:17:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pzfNG-0005TZ-AS for guix-patches@gnu.org; Thu, 18 May 2023 11:17:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#63571] [PATCH 02/14] tests: http: Allow responses to specify a path. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 18 May 2023 15:17:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 63571 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 63571@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 63571-submit@debbugs.gnu.org id=B63571.168442300720929 (code B ref 63571); Thu, 18 May 2023 15:17:02 +0000 Received: (at 63571) by debbugs.gnu.org; 18 May 2023 15:16:47 +0000 Received: from localhost ([127.0.0.1]:54104 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pzfN0-0005RK-0q for submit@debbugs.gnu.org; Thu, 18 May 2023 11:16:47 -0400 Received: from eggs.gnu.org ([209.51.188.92]:36038) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pzfMu-0005QJ-4e for 63571@debbugs.gnu.org; Thu, 18 May 2023 11:16:43 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pzfMo-0001uH-Pm; Thu, 18 May 2023 11:16:34 -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=1yMtIaWuVCAgp6QB2/sf3vlkBnpA9uBYSZLoNNQ3Pos=; b=Et9Mqof3bdhmPkvYz5GH 0zE4/WBWGhKQ5uLKgbzl7/gIShwb/rtLqA1y+jWioz85BnWjI3mHONGHQfcpPaBcwBCnBqoNhW4Ma nFG4+PkFj9B6cjzl1Q9W5UImvtX6hNF4eZmeodvBSaEokyxa3WmJD8eWVC9fiZDqcMIan7vr0GUI0 IMi3LlAL0vtTYqgUTSJRC2UHsV7CbqBkf7szjovIBgOBrLCwdGfVxaYAJkjqsIlzyxBLsVd4I76R+ IplEe6SDzquRAkKUchGVlz0+SLYtllBFs2/hI0ziPZYr96BA1IwKnFUdZ9BF11UanmBeJmvSJSt9e mhDr7Ht2610GlQ==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201] helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pzfMo-0007G6-D0; Thu, 18 May 2023 11:16:34 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Thu, 18 May 2023 17:16:10 +0200 Message-Id: <377e18f66e83d7ad8f64acbbe2f03667a8de6493.1684421460.git.ludo@gnu.org> X-Mailer: git-send-email 2.40.1 In-Reply-To: References: 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-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches * guix/tests/http.scm (%local-url): Add #:path parameter and honor it. (call-with-http-server)[responses]: Add extra clause with 'path'. [bad-request]: New variable. [server-body]: Handle three-element clauses. Wrap 'run-server' call in 'parameterize'. --- guix/tests/http.scm | 46 +++++++++++++++++++++++++++++++++++++++------ 1 file changed, 40 insertions(+), 6 deletions(-) diff --git a/guix/tests/http.scm b/guix/tests/http.scm index 37e5744353..17485df9ef 100644 --- a/guix/tests/http.scm +++ b/guix/tests/http.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016, 2017, 2019 Ludovic Courtès +;;; Copyright © 2014-2017, 2019, 2023 Ludovic Courtès ;;; Copyright © 2021 Maxime Devos ;;; ;;; This file is part of GNU Guix. @@ -21,7 +21,10 @@ (define-module (guix tests http) #:use-module (ice-9 threads) #:use-module (web server) #:use-module (web server http) + #:use-module (web request) #:use-module (web response) + #:use-module (web uri) + #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (ice-9 match) #:export (with-http-server @@ -60,12 +63,13 @@ (define (open-http-server-socket) (strerror err)) (values #f #f))))) -(define* (%local-url #:optional (port (%http-server-port))) +(define* (%local-url #:optional (port (%http-server-port)) + #:key (path "/foo/bar")) (when (= port 0) (error "no web server is running!")) ;; URL to use for 'home-page' tests. (string-append "http://localhost:" (number->string port) - "/foo/bar")) + path)) (define* (call-with-http-server responses+data thunk) "Call THUNK with an HTTP server running and returning RESPONSES+DATA on HTTP @@ -81,6 +85,18 @@ (define* (call-with-http-server responses+data thunk) (((? integer? code) data) (list (build-response #:code code #:reason-phrase "Such is life") + data)) + (((? string? path) (? integer? code) data) + (list path + (build-response #:code code + #:headers + (if (string? data) + '() + '((content-type ;binary data + . (application/octet-stream + (charset + . "ISO-8859-1"))))) + #:reason-phrase "Such is life") data))) responses+data)) @@ -116,19 +132,37 @@ (define* (call-with-http-server responses+data thunk) http-write (@@ (web server http) http-close)) + (define bad-request + (build-response #:code 400 #:reason-phrase "Unexpected request")) + (define (server-body) (define (handle request body) (match responses (((response data) rest ...) (set! responses rest) - (values response data)))) + (values response data)) + ((((? string?) response data) ...) + (let ((path (uri-path (request-uri request)))) + (match (assoc path responses) + (#f (values bad-request "")) + ((_ response data) + (if (eq? 'GET (request-method request)) + ;; Note: Use 'assoc-remove!' to remove only the first entry + ;; with PATH as its key. That way, RESPONSES can contain + ;; the same path several times. + (let ((rest (assoc-remove! responses path))) + (set! responses rest) + (values response data)) + (values bad-request "")))))))) (let-values (((socket port) (open-http-server-socket))) (set! %http-real-server-port port) (catch 'quit (lambda () - (run-server handle stub-http-server - `(#:socket ,socket))) + ;; Let HANDLE refer to '%http-server-port' if needed. + (parameterize ((%http-server-port %http-real-server-port)) + (run-server handle stub-http-server + `(#:socket ,socket)))) (lambda _ (close-port socket))))) From patchwork Thu May 18 15:16:11 2023 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: 50108 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 EBF8227BBE2; Thu, 18 May 2023 16:17:32 +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=-3.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H2,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 0562617A6F for ; Thu, 18 May 2023 16:17:30 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pzfNX-0003X5-Ep; Thu, 18 May 2023 11:17:19 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pzfNH-0003Jx-M3 for guix-patches@gnu.org; Thu, 18 May 2023 11:17:11 -0400 Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1pzfNH-0001yK-DS for guix-patches@gnu.org; Thu, 18 May 2023 11:17:03 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pzfNH-0005Tq-9G; Thu, 18 May 2023 11:17:03 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#63571] [PATCH 03/14] tests: pypi: Rewrite tests using a local HTTP server. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: lars@6xq.net, jgart@dismail.de, guix-patches@gnu.org Resent-Date: Thu, 18 May 2023 15:17:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 63571 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 63571@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= , Lars-Dominik Braun , jgart X-Debbugs-Original-Xcc: Lars-Dominik Braun , jgart Received: via spool by 63571-submit@debbugs.gnu.org id=B63571.168442301320988 (code B ref 63571); Thu, 18 May 2023 15:17:03 +0000 Received: (at 63571) by debbugs.gnu.org; 18 May 2023 15:16:53 +0000 Received: from localhost ([127.0.0.1]:54120 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pzfN6-0005SL-Jg for submit@debbugs.gnu.org; Thu, 18 May 2023 11:16:53 -0400 Received: from eggs.gnu.org ([209.51.188.92]:36048) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pzfMu-0005QK-Rz for 63571@debbugs.gnu.org; Thu, 18 May 2023 11:16:44 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pzfMp-0001uX-L7; Thu, 18 May 2023 11:16:35 -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=9acy7dFxmYLRm9RgQEX/mRC60jmS2lpyYdbTMu1rC7U=; b=ee3SlO8P2jAVb2FS77yT Ji1OD8JLkBs8pzoDCBwjA+bKyBkwUyieCofskZnNw2x82tclRpTBIKAqC+ifUW77K5kK33yu9fYYU aC5zCwOooJgt/uogAB28An+kkL6FKGqAbXMoak+snI3MeHLQvqvceniE8TKpZ4pf0DjmARMBiXIx8 ByM2Tzro7TnQGga/KQRqMmp2pcaHsF4KeCZJkhjO9w+4FwJeWCYUFYKTNrQTCUd7SkMJ1G2cPu0C5 0sgTiFeNJWo+BFvi+Df26QXEMd8N1QLmTT6WUqP56q+BUTd3HoJIJfmRXIfgnfw3NHy2e98YXUjDU l0lzOUZdVlpC4A==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201] helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pzfMp-0007G6-6o; Thu, 18 May 2023 11:16:35 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Thu, 18 May 2023 17:16:11 +0200 Message-Id: X-Mailer: git-send-email 2.40.1 In-Reply-To: References: 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-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches * guix/import/pypi.scm (%pypi-base-url): New variable. (pypi-fetch): Use it. * tests/pypi.scm (foo-json): Compute URLs relative to '%local-url'. (test-json-1, test-json-2, test-source-hash): Remove. (file-dump): New procedure. (with-pypi): New macro. ("pypi->guix-package, no wheel") ("pypi->guix-package, wheels") ("pypi->guix-package, no usable requirement file.") ("pypi->guix-package, package name contains \"-\" followed by digits"): Rewrite using 'with-pypi'. --- guix/import/pypi.scm | 9 +- tests/pypi.scm | 353 +++++++++++++++++++------------------------ 2 files changed, 160 insertions(+), 202 deletions(-) diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm index f780bf1f15..8c06b19cff 100644 --- a/guix/import/pypi.scm +++ b/guix/import/pypi.scm @@ -55,7 +55,8 @@ (define-module (guix import pypi) #:use-module (guix packages) #:use-module (guix upstream) #:use-module ((guix licenses) #:prefix license:) - #:export (parse-requires.txt + #:export (%pypi-base-url + parse-requires.txt parse-wheel-metadata specification->requirement-name guix-package->pypi-name @@ -67,6 +68,10 @@ (define-module (guix import pypi) ;; The PyPI API (notice the rhyme) is "documented" at: ;; . +(define %pypi-base-url + ;; Base URL of the PyPI API. + (make-parameter "https://pypi.org/pypi/")) + (define non-empty-string-or-false (match-lambda ("" #f) @@ -123,7 +128,7 @@ (define-json-mapping make-distribution distribution? (define (pypi-fetch name) "Return a record for package NAME, or #f on failure." - (and=> (json-fetch (string-append "https://pypi.org/pypi/" name "/json")) + (and=> (json-fetch (string-append (%pypi-base-url) name "/json")) json->pypi-project)) ;; For packages found on PyPI that lack a source distribution. diff --git a/tests/pypi.scm b/tests/pypi.scm index 1c85e6a16f..497744511f 100644 --- a/tests/pypi.scm +++ b/tests/pypi.scm @@ -27,10 +27,11 @@ (define-module (test-pypi) #:use-module (guix utils) #:use-module (gcrypt hash) #:use-module (guix tests) + #:use-module (guix tests http) #:use-module (guix build-system python) #:use-module ((guix build utils) #:select (delete-file-recursively - which mkdir-p + which mkdir-p dump-port with-directory-excursion)) #:use-module ((guix diagnostics) #:select (guix-warning-port)) #:use-module ((guix build syscalls) #:select (mkdtemp!)) @@ -57,25 +58,19 @@ (define* (foo-json #:key (name "foo") (name-in-url #f)) (urls . #()) (releases . ((1.0.0 - . #(((url . ,(format #f "https://example.com/~a-1.0.0.egg" + . #(((url . ,(format #f "~a/~a-1.0.0.egg" + (%local-url #:path "") (or name-in-url name))) (packagetype . "bdist_egg")) - ((url . ,(format #f "https://example.com/~a-1.0.0.tar.gz" + ((url . ,(format #f "~a/~a-1.0.0.tar.gz" + (%local-url #:path "") (or name-in-url name))) (packagetype . "sdist")) - ((url . ,(format #f "https://example.com/~a-1.0.0-py2.py3-none-any.whl" + ((url . ,(format #f "~a/~a-1.0.0-py2.py3-none-any.whl" + (%local-url #:path "") (or name-in-url name))) (packagetype . "bdist_wheel"))))))))) -(define test-json-1 - (foo-json)) - -(define test-json-2 - (foo-json #:name "foo-99")) - -(define test-source-hash - "") - (define test-specifications '("Fizzy [foo, bar]" "PickyThing<1.6,>1.9,!=1.9.6,<2.0a0,==2.4c1" @@ -187,6 +182,18 @@ (define (wheel-file name specs) (delete-file-recursively directory) whl-file)) +(define (file-dump file) + "Return a procedure that dumps FILE to the given port." + (lambda (output) + (call-with-input-file file + (lambda (input) + (dump-port input output))))) + +(define-syntax-rule (with-pypi responses body ...) + (with-http-server responses + (parameterize ((%pypi-base-url (%local-url #:path "/"))) + body ...))) + (test-begin "pypi") @@ -275,200 +282,146 @@ (define (wheel-file name specs) "https://files.pythonhosted.org/packages/f0/f00/goo-0.0.0.tar.gz")) (test-assert "pypi->guix-package, no wheel" - ;; Replace network resources with sample data. - (mock ((guix import utils) url-fetch - (lambda (url file-name) - (match url - ("https://example.com/foo-1.0.0.tar.gz" - ;; Unusual requires.txt location should still be found. - (let ((tarball (pypi-tarball "foo-1.0.0" - `(("src/bizarre.egg-info/requires.txt" - ,test-requires.txt))))) - (copy-file tarball file-name) - (set! test-source-hash - (call-with-input-file file-name port-sha256)))) - ("https://example.com/foo-1.0.0-py2.py3-none-any.whl" #f) - (_ (error "Unexpected URL: " url))))) - (mock ((guix http-client) http-fetch - (lambda (url . rest) - (match url - ("https://pypi.org/pypi/foo/json" - (values (open-input-string test-json-1) - (string-length test-json-1))) - ("https://example.com/foo-1.0.0-py2.py3-none-any.whl" #f) - (_ (error "Unexpected URL: " url))))) - (match (pypi->guix-package "foo") - (('package - ('name "python-foo") - ('version "1.0.0") - ('source ('origin - ('method 'url-fetch) - ('uri ('pypi-uri "foo" 'version)) - ('sha256 - ('base32 - (? string? hash))))) - ('build-system 'pyproject-build-system) - ('propagated-inputs ('list 'python-bar 'python-foo)) - ('native-inputs ('list 'python-pytest)) - ('home-page "http://example.com") - ('synopsis "summary") - ('description "summary") - ('license 'license:lgpl2.0)) - (and (string=? (bytevector->nix-base32-string - test-source-hash) - hash) - (equal? (pypi->guix-package "foo" #:version "1.0.0") - (pypi->guix-package "foo")) - (guard (c ((error? c) #t)) - (pypi->guix-package "foo" #:version "42")))) - (x - (pk 'fail x #f)))))) + (let ((tarball (pypi-tarball + "foo-1.0.0" + `(("src/bizarre.egg-info/requires.txt" + ,test-requires.txt)))) + (twice (lambda (lst) (append lst lst)))) + (with-pypi (twice `(("/foo-1.0.0.tar.gz" 200 ,(file-dump tarball)) + ("/foo-1.0.0-py2.py3-none-any.whl" 404 "") + ("/foo/json" 200 ,(lambda (port) + (display (foo-json) port))))) + (match (pypi->guix-package "foo") + (('package + ('name "python-foo") + ('version "1.0.0") + ('source ('origin + ('method 'url-fetch) + ('uri ('pypi-uri "foo" 'version)) + ('sha256 + ('base32 + (? string? hash))))) + ('build-system 'pyproject-build-system) + ('propagated-inputs ('list 'python-bar 'python-foo)) + ('native-inputs ('list 'python-pytest)) + ('home-page "http://example.com") + ('synopsis "summary") + ('description "summary") + ('license 'license:lgpl2.0)) + (and (string=? (bytevector->nix-base32-string + (file-sha256 tarball)) + hash) + (equal? (pypi->guix-package "foo" #:version "1.0.0") + (pypi->guix-package "foo")) + (guard (c ((error? c) #t)) + (pypi->guix-package "foo" #:version "42")))) + (x + (pk 'fail x #f)))))) (test-skip (if (which "zip") 0 1)) (test-assert "pypi->guix-package, wheels" - ;; Replace network resources with sample data. - (mock ((guix import utils) url-fetch - (lambda (url file-name) - (match url - ("https://example.com/foo-1.0.0.tar.gz" - (let ((tarball (pypi-tarball - "foo-1.0.0" - '(("foo-1.0.0/foo.egg-info/requires.txt" - "wrong data \ -to make sure we're testing wheels"))))) - (copy-file tarball file-name) - (set! test-source-hash - (call-with-input-file file-name port-sha256)))) - ("https://example.com/foo-1.0.0-py2.py3-none-any.whl" - (let ((wheel (wheel-file "foo-1.0.0" - `(("METADATA" ,test-metadata))))) - (copy-file wheel file-name))) - (_ (error "Unexpected URL: " url))))) - (mock ((guix http-client) http-fetch - (lambda (url . rest) - (match url - ("https://pypi.org/pypi/foo/json" - (values (open-input-string test-json-1) - (string-length test-json-1))) - ("https://example.com/foo-1.0.0-py2.py3-none-any.whl" #f) - (_ (error "Unexpected URL: " url))))) - ;; Not clearing the memoization cache here would mean returning the value - ;; computed in the previous test. - (invalidate-memoization! pypi->guix-package) - (match (pypi->guix-package "foo") - (('package - ('name "python-foo") - ('version "1.0.0") - ('source ('origin - ('method 'url-fetch) - ('uri ('pypi-uri "foo" 'version)) - ('sha256 - ('base32 - (? string? hash))))) - ('build-system 'pyproject-build-system) - ('propagated-inputs ('list 'python-bar 'python-baz)) - ('native-inputs ('list 'python-pytest)) - ('home-page "http://example.com") - ('synopsis "summary") - ('description "summary") - ('license 'license:lgpl2.0)) - (string=? (bytevector->nix-base32-string - test-source-hash) - hash)) - (x - (pk 'fail x #f)))))) + (let ((tarball (pypi-tarball + "foo-1.0.0" + '(("foo-1.0.0/foo.egg-info/requires.txt" + "wrong data \ +to make sure we're testing wheels")))) + (wheel (wheel-file "foo-1.0.0" + `(("METADATA" ,test-metadata))))) + (with-pypi `(("/foo-1.0.0.tar.gz" 200 ,(file-dump tarball)) + ("/foo-1.0.0-py2.py3-none-any.whl" + 200 ,(file-dump wheel)) + ("/foo/json" 200 ,(lambda (port) + (display (foo-json) port)))) + ;; Not clearing the memoization cache here would mean returning the value + ;; computed in the previous test. + (invalidate-memoization! pypi->guix-package) + (match (pypi->guix-package "foo") + (('package + ('name "python-foo") + ('version "1.0.0") + ('source ('origin + ('method 'url-fetch) + ('uri ('pypi-uri "foo" 'version)) + ('sha256 + ('base32 + (? string? hash))))) + ('build-system 'pyproject-build-system) + ('propagated-inputs ('list 'python-bar 'python-baz)) + ('native-inputs ('list 'python-pytest)) + ('home-page "http://example.com") + ('synopsis "summary") + ('description "summary") + ('license 'license:lgpl2.0)) + (string=? (bytevector->nix-base32-string (file-sha256 tarball)) + hash)) + (x + (pk 'fail x #f)))))) (test-assert "pypi->guix-package, no usable requirement file." - ;; Replace network resources with sample data. - (mock ((guix import utils) url-fetch - (lambda (url file-name) - (match url - ("https://example.com/foo-1.0.0.tar.gz" - (let ((tarball (pypi-tarball "foo-1.0.0" - '(("foo.egg-info/.empty" ""))))) - (copy-file tarball file-name) - (set! test-source-hash - (call-with-input-file file-name port-sha256)))) - ("https://example.com/foo-1.0.0-py2.py3-none-any.whl" #f) - (_ (error "Unexpected URL: " url))))) - (mock ((guix http-client) http-fetch - (lambda (url . rest) - (match url - ("https://pypi.org/pypi/foo/json" - (values (open-input-string test-json-1) - (string-length test-json-1))) - ("https://example.com/foo-1.0.0-py2.py3-none-any.whl" #f) - (_ (error "Unexpected URL: " url))))) - ;; Not clearing the memoization cache here would mean returning the value - ;; computed in the previous test. - (invalidate-memoization! pypi->guix-package) - (match (pypi->guix-package "foo") - (('package - ('name "python-foo") - ('version "1.0.0") - ('source ('origin - ('method 'url-fetch) - ('uri ('pypi-uri "foo" 'version)) - ('sha256 - ('base32 - (? string? hash))))) - ('build-system 'pyproject-build-system) - ('home-page "http://example.com") - ('synopsis "summary") - ('description "summary") - ('license 'license:lgpl2.0)) - (string=? (bytevector->nix-base32-string - test-source-hash) - hash)) - (x - (pk 'fail x #f)))))) + (let ((tarball (pypi-tarball "foo-1.0.0" + '(("foo.egg-info/.empty" ""))))) + (with-pypi `(("/foo-1.0.0.tar.gz" 200 ,(file-dump tarball)) + ("/foo-1.0.0-py2.py3-none-any.whl" 404 "") + ("/foo/json" 200 ,(lambda (port) + (display (foo-json) port)))) + ;; Not clearing the memoization cache here would mean returning the + ;; value computed in the previous test. + (invalidate-memoization! pypi->guix-package) + (match (pypi->guix-package "foo") + (('package + ('name "python-foo") + ('version "1.0.0") + ('source ('origin + ('method 'url-fetch) + ('uri ('pypi-uri "foo" 'version)) + ('sha256 + ('base32 + (? string? hash))))) + ('build-system 'pyproject-build-system) + ('home-page "http://example.com") + ('synopsis "summary") + ('description "summary") + ('license 'license:lgpl2.0)) + (string=? (bytevector->nix-base32-string (file-sha256 tarball)) + hash)) + (x + (pk 'fail x #f)))))) (test-assert "pypi->guix-package, package name contains \"-\" followed by digits" - ;; Replace network resources with sample data. - (mock ((guix import utils) url-fetch - (lambda (url file-name) - (match url - ("https://example.com/foo-99-1.0.0.tar.gz" - (let ((tarball (pypi-tarball "foo-99-1.0.0" - `(("src/bizarre.egg-info/requires.txt" - ,test-requires.txt))))) - ;; Unusual requires.txt location should still be found. - (copy-file tarball file-name) - (set! test-source-hash - (call-with-input-file file-name port-sha256)))) - ("https://example.com/foo-99-1.0.0-py2.py3-none-any.whl" #f) - (_ (error "Unexpected URL: " url))))) - (mock ((guix http-client) http-fetch - (lambda (url . rest) - (match url - ("https://pypi.org/pypi/foo-99/json" - (values (open-input-string test-json-2) - (string-length test-json-2))) - ("https://example.com/foo-99-1.0.0-py2.py3-none-any.whl" #f) - (_ (error "Unexpected URL: " url))))) - (match (pypi->guix-package "foo-99") - (('package - ('name "python-foo-99") - ('version "1.0.0") - ('source ('origin - ('method 'url-fetch) - ('uri ('pypi-uri "foo-99" 'version)) - ('sha256 - ('base32 - (? string? hash))))) - ('properties ('quote (("upstream-name" . "foo-99")))) - ('build-system 'pyproject-build-system) - ('propagated-inputs ('list 'python-bar 'python-foo)) - ('native-inputs ('list 'python-pytest)) - ('home-page "http://example.com") - ('synopsis "summary") - ('description "summary") - ('license 'license:lgpl2.0)) - (string=? (bytevector->nix-base32-string - test-source-hash) - hash)) - (x - (pk 'fail x #f)))))) + (let ((tarball (pypi-tarball "foo-99-1.0.0" + `(("src/bizarre.egg-info/requires.txt" + ,test-requires.txt))))) + (with-pypi `(("/foo-99-1.0.0.tar.gz" 200 ,(file-dump tarball)) + ("/foo-99-1.0.0-py2.py3-none-any.whl" 404 "") + ("/foo-99/json" 200 ,(lambda (port) + (display (foo-json #:name "foo-99") + port)))) + (match (pypi->guix-package "foo-99") + (('package + ('name "python-foo-99") + ('version "1.0.0") + ('source ('origin + ('method 'url-fetch) + ('uri ('pypi-uri "foo-99" 'version)) + ('sha256 + ('base32 + (? string? hash))))) + ('properties ('quote (("upstream-name" . "foo-99")))) + ('build-system 'pyproject-build-system) + ('propagated-inputs ('list 'python-bar 'python-foo)) + ('native-inputs ('list 'python-pytest)) + ('home-page "http://example.com") + ('synopsis "summary") + ('description "summary") + ('license 'license:lgpl2.0)) + (string=? (bytevector->nix-base32-string (file-sha256 tarball)) + hash)) + (x + (pk 'fail x #f)))))) (test-end "pypi") (delete-file-recursively sample-directory) + +;; Local Variables: +;; eval: (put 'with-pypi 'scheme-indent-function 1) +;; End: From patchwork Thu May 18 15:16:12 2023 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: 50111 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 CD99627BBE2; Thu, 18 May 2023 16:17:52 +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=-3.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H2,SPF_HELO_PASS, URIBL_BLOCKED autolearn=ham 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 2680217A6F for ; Thu, 18 May 2023 16:17:52 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pzfNf-0003e2-4b; Thu, 18 May 2023 11:17:28 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pzfNH-0003Jw-9l for guix-patches@gnu.org; Thu, 18 May 2023 11:17:11 -0400 Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1pzfNH-0001yC-1C for guix-patches@gnu.org; Thu, 18 May 2023 11:17:03 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pzfNG-0005Th-T8 for guix-patches@gnu.org; Thu, 18 May 2023 11:17:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#63571] [PATCH 04/14] import: utils: 'call-with-networking-exception-handler' doesn't unwind. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 18 May 2023 15:17:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 63571 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 63571@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 63571-submit@debbugs.gnu.org id=B63571.168442301220980 (code B ref 63571); Thu, 18 May 2023 15:17:02 +0000 Received: (at 63571) by debbugs.gnu.org; 18 May 2023 15:16:52 +0000 Received: from localhost ([127.0.0.1]:54118 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pzfN6-0005SE-7w for submit@debbugs.gnu.org; Thu, 18 May 2023 11:16:52 -0400 Received: from eggs.gnu.org ([209.51.188.92]:36056) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pzfMv-0005QN-ME for 63571@debbugs.gnu.org; Thu, 18 May 2023 11:16:44 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pzfMq-0001ui-Fp; Thu, 18 May 2023 11:16:36 -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=fxmA7SgFcntyA5wRPbxN7LoFNiFasucsGTERoU5qcPE=; b=B+WSVuUnLO9fq/O0PJlW oglMxj9NKLy1VEYCyJJwRo9UBf1DZT7ABAWfblctwZNWZs/WQsowEODfY8scVCx92TO0OV+v+u6It RHuOQ4E6u/Lf2BQJGLU647PnV4drznZivdgvCfbQb+bTxzBH/YTEgJiFVTw/wAMdfHLnYku73/sUw FdgALwVmqTMc/XEPScanBGq/nfhkLuHU6y026vMDGytMdy/5VCR2Dd8fr8hiJIkZ4POWROTBDFzur Qxm0PDEDwn6LuI9wKCE/5WDDFBr2liEI2jbv05MkI8ku+OBJ2RNvTiNxqofOBccBnF43PtadXFVOs hdX8AugCeT38dg==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201] helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pzfMq-0007G6-2j; Thu, 18 May 2023 11:16:36 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Thu, 18 May 2023 17:16:12 +0200 Message-Id: <507259949ceaf08af93f2d4e17e61797f86989b2.1684421460.git.ludo@gnu.org> X-Mailer: git-send-email 2.40.1 In-Reply-To: References: 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-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches That way backtraces show where the error actually originates from. * guix/import/utils.scm (call-with-networking-exception-handler): Rewrite using 'with-exception-handler'. --- guix/import/utils.scm | 33 +++++++++++++++++++++------------ 1 file changed, 21 insertions(+), 12 deletions(-) diff --git a/guix/import/utils.scm b/guix/import/utils.scm index 177817b10c..e9a0a7ecd7 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -45,6 +45,7 @@ (define-module (guix import utils) #:use-module (guix sets) #:use-module ((guix ui) #:select (fill-paragraph)) #:use-module (gnu packages) + #:autoload (ice-9 control) (let/ec) #:use-module (ice-9 match) #:use-module (ice-9 rdelim) #:use-module (ice-9 receive) @@ -126,18 +127,26 @@ (define (flatten lst) (define (call-with-networking-exception-handler thunk) "Invoke THUNK, returning #f if one of the usual networking exception is thrown." - (catch #t - (lambda () - (guard (c ((http-get-error? c) #f)) - (thunk))) - (lambda (key . args) - ;; Return false and move on upon connection failures and bogus HTTP - ;; servers. - (unless (memq key '(gnutls-error tls-certificate-error - system-error getaddrinfo-error - bad-header bad-header-component)) - (apply throw key args)) - #f))) + (let/ec return + (with-exception-handler + (lambda (exception) + (cond ((http-get-error? exception) + (return #f)) + (((exception-predicate &exception-with-kind-and-args) exception) + ;; Return false and move on upon connection failures and bogus + ;; HTTP servers. + (if (memq (exception-kind exception) + '(gnutls-error tls-certificate-error + system-error getaddrinfo-error + bad-header bad-header-component)) + (return #f) + (raise-exception exception))) + (else + (raise-exception exception)))) + thunk + + ;; Do not unwind to preserve meaningful backtraces. + #:unwind? #f))) (define-syntax-rule (false-if-networking-error exp) "Evaluate EXP, returning #f if a networking-related exception is thrown." From patchwork Thu May 18 15:16:13 2023 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: 50117 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 F386527BBE2; Thu, 18 May 2023 16:18:20 +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=-3.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H2,SPF_HELO_PASS, URIBL_BLOCKED autolearn=ham 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 4923717A88 for ; Thu, 18 May 2023 16:18:20 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pzfNq-0003pf-Bj; Thu, 18 May 2023 11:17:38 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pzfNI-0003K3-18 for guix-patches@gnu.org; Thu, 18 May 2023 11:17:11 -0400 Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1pzfNH-0001yP-PN for guix-patches@gnu.org; Thu, 18 May 2023 11:17:03 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pzfNH-0005Tz-L8 for guix-patches@gnu.org; Thu, 18 May 2023 11:17:03 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#63571] [PATCH 05/14] import: json: Add #:timeout to 'json-fetch'. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 18 May 2023 15:17:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 63571 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 63571@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 63571-submit@debbugs.gnu.org id=B63571.168442301420996 (code B ref 63571); Thu, 18 May 2023 15:17:03 +0000 Received: (at 63571) by debbugs.gnu.org; 18 May 2023 15:16:54 +0000 Received: from localhost ([127.0.0.1]:54122 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pzfN7-0005ST-Kt for submit@debbugs.gnu.org; Thu, 18 May 2023 11:16:54 -0400 Received: from eggs.gnu.org ([209.51.188.92]:36058) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pzfMw-0005QP-GF for 63571@debbugs.gnu.org; Thu, 18 May 2023 11:16:45 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pzfMr-0001uw-A5; Thu, 18 May 2023 11:16:37 -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=xLJLuPY/dTyxQSRRSJ+fiiUi/deSy30n6aZaQDZV5oc=; b=FrGv1qRhuEEFV41c8/BQ iDahlPctHsuaOLNCHZrlR3Fe/hgABYHkTKEghBRmvlYCDPjNoSjW+JqhwNBuLtVqQNpOBTFMd17ba DO8sOVO+owQbDmNsAkmZYY9L98xT1PHt9S0OBLOaeF5a/TlxG3YBdll5jadXDclNsrkerqkLfPtA7 7cv2qj5nU3d96J/7SiTkTkRPWXtSt1Sil/O7DEFfLCFMRgQIwuSkoVClR7HXlre2wODuM2qcbm8hH 46xDvNquXcqMFkdQzYzBdqo61eolA0knKNV16X67zfBTn0xoCB+sHjCHwscFHYQaKKxBF4kRnVBUL vXKOS07VuCaU7g==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201] helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pzfMq-0007G6-TC; Thu, 18 May 2023 11:16:37 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Thu, 18 May 2023 17:16:13 +0200 Message-Id: <0aa7fa1673b00a47cfae4aed6d0fe409ab01eed2.1684421460.git.ludo@gnu.org> X-Mailer: git-send-email 2.40.1 In-Reply-To: References: 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-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches * guix/import/json.scm (json-fetch): Add #:timeout and pass it to 'http-fetch'. --- guix/import/json.scm | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/guix/import/json.scm b/guix/import/json.scm index ae00ee929e..b87e9918c5 100644 --- a/guix/import/json.scm +++ b/guix/import/json.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014 David Thompson ;;; Copyright © 2015, 2016 Eric Bavier -;;; Copyright © 2018, 2019 Ludovic Courtès +;;; Copyright © 2018, 2019, 2023 Ludovic Courtès ;;; Copyright © 2020 Ricardo Wurmus ;;; ;;; This file is part of GNU Guix. @@ -37,6 +37,7 @@ (define-module (guix import json) (define* (json-fetch url #:key (http-fetch http-fetch) + (timeout 10) ;; Note: many websites returns 403 if we omit a ;; 'User-Agent' header. (headers `((user-agent . "GNU Guile") @@ -50,7 +51,7 @@ (define* (json-fetch url (or (= 403 error) (= 404 error)))) #f)) - (let* ((port (http-fetch url #:headers headers)) + (let* ((port (http-fetch url #:timeout timeout #:headers headers)) (result (json->scm port))) (close-port port) result))) From patchwork Thu May 18 15:16:14 2023 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: 50121 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 E6DD417A9A; Thu, 18 May 2023 16:18:38 +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=-3.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H2,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 8AB1C17A88 for ; Thu, 18 May 2023 16:18:36 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pzfON-0004k2-JI; Thu, 18 May 2023 11:18:11 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pzfOJ-0004gy-H2 for guix-patches@gnu.org; Thu, 18 May 2023 11:18:10 -0400 Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1pzfOJ-0002BF-7y; Thu, 18 May 2023 11:18:07 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pzfOE-0005XS-9O; Thu, 18 May 2023 11:18:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#63571] [PATCH 06/14] upstream: Replace 'input-changes' field by 'inputs'. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: mail@cbaines.net, dev@jpoiret.xyz, lars@6xq.net, ludo@gnu.org, othacehe@gnu.org, rekado@elephly.net, zimon.toutoune@gmail.com, me@tobias.gr, jgart@dismail.de, guix-patches@gnu.org Resent-Date: Thu, 18 May 2023 15:18:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 63571 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 63571@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= , Christopher Baines , Josselin Poiret , Lars-Dominik Braun , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice , jgart X-Debbugs-Original-Xcc: Christopher Baines , Josselin Poiret , Lars-Dominik Braun , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice , jgart Received: via spool by 63571-submit@debbugs.gnu.org id=B63571.168442303021166 (code B ref 63571); Thu, 18 May 2023 15:18:02 +0000 Received: (at 63571) by debbugs.gnu.org; 18 May 2023 15:17:10 +0000 Received: from localhost ([127.0.0.1]:54158 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pzfNL-0005V5-Ok for submit@debbugs.gnu.org; Thu, 18 May 2023 11:17:09 -0400 Received: from eggs.gnu.org ([209.51.188.92]:36072) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pzfMx-0005QR-Hw for 63571@debbugs.gnu.org; Thu, 18 May 2023 11:16:48 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pzfMs-0001v8-BO; Thu, 18 May 2023 11:16:38 -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=HAOCUD3kSrM60g4PHRoqrOCM6ypBIxQxDIWOSpqeBAk=; b=pqb+YG5GrLdqdmqOL5Oz qbkD2qWG6zxIOIbzx6vF3/1sYjhutoIhU5DNYMdf2P91r4c+Nk/iX5EBu/9unbH2lyQxVYK1caEyX zoLLdnqNVoFynOfd2aurXMqCriM/8xKIk4+tiddIaJ8WIsL6PQdLBRSR4cFOTWRYl1q4riz7qTn0T OVGYYABWgMh47h5kYSsZo1eU3NhIjLRYjORiAwqIz66emT+O7an3GpQogzV3t2kbQKRm043tT2PlT uXhp0bX+LDfuynPGhnanxObRdcGCiMnHWfNEK8BEUfj3D752ML/gb9jMuBeUL6lAxT+yyIcuSjib4 e2LFfGkvamz7iw==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201] helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pzfMr-0007G6-Ob; Thu, 18 May 2023 11:16:38 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Thu, 18 May 2023 17:16:14 +0200 Message-Id: <444e3752a58e7bbcbb093313f908ccbb8b5360f5.1684421460.git.ludo@gnu.org> X-Mailer: git-send-email 2.40.1 In-Reply-To: References: 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-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches Returning the expected list of inputs rather than changes relative to the current package definition is less ambiguous and offers more possibilities for further processing. * guix/upstream.scm ()[input-changes]: Remove. [inputs]: New field. (): New record type. * guix/upstream.scm (upstream-input-type-predicate) (input-type-filter, upstream-source-regular-inputs) (upstream-source-native-inputs, upstream-source-propagated-inputs): New procedures. (changed-inputs): Expect an as its second argument. Adjust accordingly. * guix/import/pypi.scm (distribution-sha256): New procedure. (maybe-inputs): Expect a list of . (compute-inputs): Rewrite to return a list of . (pypi-package-inputs, pypi-package->upstream-source): New procedures. (make-pypi-sexp): Use it. * guix/import/stackage.scm (latest-lts-release): Define 'cabal'. Replace 'input-changes' field by 'inputs'. * guix/scripts/refresh.scm (update-package): Use 'changed-inputs' instead of 'upstream-source-input-changes'. * tests/cran.scm ("description->package"): Adjust order of inputs. * tests/pypi.scm (default-sha256, default-sha256/base32): New variables. (foo-json): Add 'digests' entry. ("pypi->guix-package, no wheel"): Check HASH against DEFAULT-SHA256/BASE32. ("pypi->guix-package, wheels"): Likewise. ("pypi->guix-package, no usable requirement file."): Likewise. ("pypi->guix-package, package name contains \"-\" followed by digits"): Likewise. ("package-latest-release"): New test. * tests/upstream.scm (test-package-sexp): Remove. ("changed-inputs returns no changes"): Rewrite to use . (test-new-package-sexp): Remove. ("changed-inputs returns changes to plain input list"): Rewrite. ("changed-inputs returns changes to all plain input lists"): Likewise. ("changed-inputs returns changes to labelled input list") ("changed-inputs returns changes to all labelled input lists"): Remove. * guix/import/cran.scm (maybe-inputs): Expect PACKAGE-INPUTS to be a list of . (source-dir->dependencies): Return a list of . (vignette-builders): Likewise. (uri-helper, cran-package-source-url) (cran-package-propagated-inputs, cran-package-inputs): New procedures. (description->package): Use them instead of local definitions. (latest-cran-release): Replace 'input-changes' field by 'inputs'. (latest-bioconductor-release): Likewise. * guix/import/hackage.scm (cabal-package-inputs): New procedure. (hackage-module->sexp): Use it. [maybe-inputs]: Expect a list of . --- guix/import/cran.scm | 180 +++++++++++++++++++++++----------- guix/import/hackage.scm | 90 ++++++++++------- guix/import/pypi.scm | 207 +++++++++++++++++++++++---------------- guix/import/stackage.scm | 9 +- guix/scripts/refresh.scm | 4 +- guix/upstream.scm | 163 ++++++++++++++++++------------ tests/cran.scm | 2 +- tests/pypi.scm | 62 ++++++++++-- tests/upstream.scm | 140 ++++++++++---------------- 9 files changed, 508 insertions(+), 349 deletions(-) diff --git a/guix/import/cran.scm b/guix/import/cran.scm index bb271634ed..40bad08407 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015-2023 Ricardo Wurmus -;;; Copyright © 2015, 2016, 2017, 2019, 2020, 2021 Ludovic Courtès +;;; Copyright © 2015-2017, 2019-2021, 2023 Ludovic Courtès ;;; Copyright © 2017 Mathieu Othacehe ;;; Copyright © 2020 Martin Becze ;;; Copyright © 2021 Sarah Morgensen @@ -174,14 +174,16 @@ (define (format-inputs names) (string->symbol name)))) (sort names string-cisymbol + upstream-input-downstream-name) + package-inputs))))))) (define %cran-url "https://cran.r-project.org/web/packages/") (define %cran-canonical-url "https://cran.r-project.org/package=") @@ -520,14 +522,29 @@ (define (directory-needs-pkg-config? dir) "(Makevars.*|configure.*)")) (define (source-dir->dependencies dir) - "Guess dependencies of R package source in DIR and return two values: a list -of package names for INPUTS and another list of names of NATIVE-INPUTS." - (values - (needed-libraries-in-directory dir) - (append - (if (directory-needs-esbuild? dir) '("esbuild") '()) - (if (directory-needs-pkg-config? dir) '("pkg-config") '()) - (if (directory-needs-fortran? dir) '("gfortran") '())))) + "Guess dependencies of R package source in DIR and return a list of + corresponding to the dependencies guessed from source files +in DIR." + (define (native name) + (upstream-input + (name name) + (downstream-name name) + (type 'native))) + + (append (map (lambda (name) + (upstream-input + (name name) + (downstream-name (cran-guix-name name)))) + (needed-libraries-in-directory dir)) + (if (directory-needs-esbuild? dir) + (list (native "esbuild")) + '()) + (if (directory-needs-pkg-config? dir) + (list (native "pkg-config")) + '()) + (if (directory-needs-fortran? dir) + (list (native "gfortran")) + '()))) (define (source->dependencies source tarball?) "SOURCE-DIR->DEPENDENCIES, but for directories and tarballs as indicated @@ -541,7 +558,75 @@ (define (source->dependencies source tarball?) (source-dir->dependencies source))) (define (vignette-builders meta) - (map cran-guix-name (listify meta "VignetteBuilder"))) + (map (lambda (name) + (upstream-input + (name name) + (downstream-name (cran-guix-name name)) + (type 'native))) + (listify meta "VignetteBuilder"))) + +(define (uri-helper repository) + (match repository + ('cran cran-uri) + ('bioconductor bioconductor-uri) + ('git #f) + ('hg #f))) + +(define (cran-package-source-url meta repository) + "Return the URL of the source code referred to by META, a package in +REPOSITORY." + (case repository + ((git) (assoc-ref meta 'git)) + ((hg) (assoc-ref meta 'hg)) + (else + (match (apply (uri-helper repository) + (assoc-ref meta "Package") + (assoc-ref meta "Version") + (case repository + ((bioconductor) + (list (assoc-ref meta 'bioconductor-type))) + (else '()))) + ((urls ...) urls) + ((? string? url) url) + (_ #f))))) + +(define (cran-package-propagated-inputs meta) + "Return the list of derived from dependency information in +META." + (filter-map (lambda (name) + (and (not (member name + (append default-r-packages invalid-packages))) + (upstream-input + (name name) + (downstream-name (cran-guix-name name)) + (type 'propagated)))) + (lset-union equal? + (listify meta "Imports") + (listify meta "LinkingTo") + (delete "R" (listify meta "Depends"))))) + +(define* (cran-package-inputs meta repository + #:key (download-source download)) + "Return the list of corresponding to all the dependencies +of META, a package in REPOSITORY." + (let* ((url (cran-package-source-url meta repository)) + (source (download-source url + #:method + (cond ((assoc-ref meta 'git) 'git) + ((assoc-ref meta 'hg) 'hg) + (else #f)))) + (tarball? (not (or (assoc-ref meta 'git) + (assoc-ref meta 'hg))))) + (append (source->dependencies source tarball?) + (filter-map (lambda (name) + (and (not (member name invalid-packages)) + (upstream-input + (name name) + (downstream-name (transform-sysname name))))) + (map string-downcase + (listify meta "SystemRequirements"))) + (cran-package-propagated-inputs meta) + (vignette-builders meta)))) (define* (description->package repository meta #:key (license-prefix identity) (download-source download)) @@ -556,11 +641,6 @@ (define* (description->package repository meta #:key (license-prefix identity) ((cran) %cran-canonical-url) ((bioconductor) %bioconductor-url) ((git) #f))) - (uri-helper (case repository - ((cran) cran-uri) - ((bioconductor) bioconductor-uri) - ((git) #f) - ((hg) #f))) (name (assoc-ref meta "Package")) (synopsis (assoc-ref meta "Title")) (version (assoc-ref meta "Version")) @@ -572,40 +652,16 @@ (define* (description->package repository meta #:key (license-prefix identity) (else (match (listify meta "URL") ((url rest ...) url) (_ (string-append canonical-url-base name)))))) - (source-url (case repository - ((git) (assoc-ref meta 'git)) - ((hg) (assoc-ref meta 'hg)) - (else - (match (apply uri-helper name version - (case repository - ((bioconductor) - (list (assoc-ref meta 'bioconductor-type))) - (else '()))) - ((urls ...) urls) - ((? string? url) url) - (_ #f))))) + (source-url (cran-package-source-url meta repository)) (git? (if (assoc-ref meta 'git) #true #false)) (hg? (if (assoc-ref meta 'hg) #true #false)) (source (download-source source-url #:method (cond (git? 'git) (hg? 'hg) (else #f)))) - (tarball? (not (or git? hg?))) - (source-inputs source-native-inputs - (source->dependencies source tarball?)) - (sysdepends (append - source-inputs - (filter (lambda (name) - (not (member name invalid-packages))) - (map string-downcase (listify meta "SystemRequirements"))))) - (propagate (filter (lambda (name) - (not (member name (append default-r-packages - invalid-packages)))) - (lset-union equal? - (listify meta "Imports") - (listify meta "LinkingTo") - (delete "R" - (listify meta "Depends"))))) + (uri-helper (uri-helper repository)) + (inputs (cran-package-inputs meta repository + #:download-source download-source)) (package `(package (name ,(cran-guix-name name)) @@ -651,12 +707,18 @@ (define* (description->package repository meta #:key (license-prefix identity) `((properties ,`(,'quasiquote ((,'upstream-name . ,name))))) '()) (build-system r-build-system) - ,@(maybe-inputs (map transform-sysname sysdepends)) - ,@(maybe-inputs (map cran-guix-name propagate) 'propagated-inputs) - ,@(maybe-inputs - `(,@source-native-inputs - ,@(vignette-builders meta)) - 'native-inputs) + + ,@(maybe-inputs (filter (upstream-input-type-predicate 'regular) + inputs) + 'inputs) + ,@(maybe-inputs (filter (upstream-input-type-predicate + 'propagated) + inputs) + 'propagated-inputs) + ,@(maybe-inputs (filter (upstream-input-type-predicate 'native) + inputs) + 'native-inputs) + (home-page ,(if (string-null? home-page) (string-append base-url name) home-page)) @@ -675,7 +737,10 @@ (define* (description->package repository meta #:key (license-prefix identity) (revision "1")) ,package)) (else package)) - propagate))) + (filter-map (lambda (input) + (and (eq? 'propagated (upstream-input-type input)) + (upstream-input-name input))) + inputs)))) (define cran->guix-package (memoize @@ -760,9 +825,7 @@ (define* (latest-cran-release pkg #:key (version #f)) (package (package-name pkg)) (version version) (urls (cran-uri upstream-name version)) - (input-changes - (changed-inputs pkg - (description->package 'cran meta))))))) + (inputs (cran-package-inputs meta 'cran)))))) (define* (latest-bioconductor-release pkg #:key (version #f)) "Return an for the latest release of the package PKG." @@ -784,10 +847,9 @@ (define* (latest-bioconductor-release pkg #:key (version #f)) (package (package-name pkg)) (version latest-version) (urls (bioconductor-uri upstream-name latest-version)) - (input-changes - (changed-inputs - pkg - (cran->guix-package upstream-name #:repo 'bioconductor)))))) + (inputs + (let ((meta (fetch-description 'bioconductor upstream-name))) + (cran-package-inputs meta 'bioconductor)))))) (define (cran-package? package) "Return true if PACKAGE is an R package from CRAN." diff --git a/guix/import/hackage.scm b/guix/import/hackage.scm index 56c8696ad7..9333bedbbd 100644 --- a/guix/import/hackage.scm +++ b/guix/import/hackage.scm @@ -8,6 +8,7 @@ ;;; Copyright © 2021 Sarah Morgensen ;;; Copyright © 2019 Simon Tournier ;;; Copyright © 2022 Hartmut Goebel +;;; Copyright © 2023 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -56,7 +57,9 @@ (define-module (guix import hackage) hackage-fetch hackage-source-url hackage-cabal-url - hackage-package?)) + hackage-package? + + cabal-package-inputs)) (define ghc-standard-libraries ;; List of libraries distributed with ghc (as of 8.10.7). @@ -224,27 +227,12 @@ (define (filter-dependencies dependencies own-names) (filter (lambda (d) (not (member (string-downcase d) ignored-dependencies))) dependencies))) -(define* (hackage-module->sexp cabal cabal-hash - #:key (include-test-dependencies? #t)) - "Return the `package' S-expression for a Cabal package. CABAL is the -representation of a Cabal file as produced by 'read-cabal'. CABAL-HASH is -the hash of the Cabal file." - - (define name - (cabal-package-name cabal)) - - (define version - (cabal-package-version cabal)) - - (define revision - (cabal-package-revision cabal)) - - (define source-url - (hackage-source-url name version)) - - (define own-names (cons (cabal-package-name cabal) - (filter (lambda (x) (not (eqv? x #f))) - (map cabal-library-name (cabal-package-library cabal))))) +(define* (cabal-package-inputs cabal #:key (include-test-dependencies? #t)) + "Return the list of for CABAL representing its +dependencies." + (define own-names + (cons (cabal-package-name cabal) + (filter-map cabal-library-name (cabal-package-library cabal)))) (define hackage-dependencies (filter-dependencies (cabal-dependencies->names cabal) own-names)) @@ -261,22 +249,54 @@ (define* (hackage-module->sexp cabal cabal-hash hackage-dependencies)) (define dependencies - (map string->symbol - (map hackage-name->package-name - hackage-dependencies))) + (map (lambda (name) + (upstream-input + (name name) + (downstream-name (hackage-name->package-name name)) + (type 'regular))) + hackage-dependencies)) (define native-dependencies - (map string->symbol - (map hackage-name->package-name - hackage-native-dependencies))) - + (map (lambda (name) + (upstream-input + (name name) + (downstream-name (hackage-name->package-name name)) + (type 'native))) + hackage-native-dependencies)) + + (append dependencies native-dependencies)) + +(define* (hackage-module->sexp cabal cabal-hash + #:key (include-test-dependencies? #t)) + "Return the `package' S-expression for a Cabal package. CABAL is the +representation of a Cabal file as produced by 'read-cabal'. CABAL-HASH is +the hash of the Cabal file." + (define name + (cabal-package-name cabal)) + + (define version + (cabal-package-version cabal)) + + (define revision + (cabal-package-revision cabal)) + + (define source-url + (hackage-source-url name version)) + + (define inputs + (cabal-package-inputs cabal + #:include-test-dependencies? + include-test-dependencies?)) + (define (maybe-inputs input-type inputs) (match inputs (() '()) ((inputs ...) (list (list input-type - `(list ,@inputs)))))) + `(list ,@(map (compose string->symbol + upstream-input-downstream-name) + inputs))))))) (define (maybe-arguments) (match (append (if (not include-test-dependencies?) @@ -304,14 +324,18 @@ (define* (hackage-module->sexp cabal cabal-hash "failed to download tar archive"))))) (build-system haskell-build-system) (properties '((upstream-name . ,name))) - ,@(maybe-inputs 'inputs dependencies) - ,@(maybe-inputs 'native-inputs native-dependencies) + ,@(maybe-inputs 'inputs + (filter (upstream-input-type-predicate 'regular) + inputs)) + ,@(maybe-inputs 'native-inputs + (filter (upstream-input-type-predicate 'native) + inputs)) ,@(maybe-arguments) (home-page ,(cabal-package-home-page cabal)) (synopsis ,(cabal-package-synopsis cabal)) (description ,(beautify-description (cabal-package-description cabal))) (license ,(string->license (cabal-package-license cabal)))) - (append hackage-dependencies hackage-native-dependencies)))) + inputs))) (define* (hackage->guix-package package-name #:key (include-test-dependencies? #t) diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm index 8c06b19cff..1a3070fb36 100644 --- a/guix/import/pypi.scm +++ b/guix/import/pypi.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014 David Thompson ;;; Copyright © 2015 Cyril Roelandt -;;; Copyright © 2015-2017, 2019-2022 Ludovic Courtès +;;; Copyright © 2015-2017, 2019-2023 Ludovic Courtès ;;; Copyright © 2017 Mathieu Othacehe ;;; Copyright © 2018, 2023 Ricardo Wurmus ;;; Copyright © 2019 Maxim Cournoyer @@ -33,12 +33,16 @@ (define-module (guix import pypi) #:use-module (ice-9 match) #:use-module (ice-9 regex) - #:use-module (ice-9 receive) #:use-module ((ice-9 rdelim) #:select (read-line)) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) + #:use-module (srfi srfi-71) + #:autoload (gcrypt hash) (port-sha256) + #:autoload (guix base16) (base16-string->bytevector) + #:autoload (guix base32) (bytevector->nix-base32-string) + #:autoload (guix http-client) (http-fetch) #:use-module (guix utils) #:use-module (guix memoization) #:use-module (guix diagnostics) @@ -126,6 +130,12 @@ (define-json-mapping make-distribution distribution? (python-version distribution-package-python-version "python_version")) +(define (distribution-sha256 distribution) + "Return the SHA256 hash of DISTRIBUTION as a bytevector, or #f." + (match (assoc-ref (distribution-digests distribution) "sha256") + (#f #f) + (str (base16-string->bytevector str)))) + (define (pypi-fetch name) "Return a record for package NAME, or #f on failure." (and=> (json-fetch (string-append (%pypi-base-url) name "/json")) @@ -198,7 +208,9 @@ (define (maybe-inputs package-inputs input-type) (() '()) ((package-inputs ...) - `((,input-type (list ,@package-inputs)))))) + `((,input-type (list ,@(map (compose string->symbol + upstream-input-downstream-name) + package-inputs))))))) (define %requirement-name-regexp ;; Regexp to match the requirement name in a requirement specification. @@ -409,23 +421,36 @@ (define (guess-requirements source-url wheel-url archive) (define (compute-inputs source-url wheel-url archive) "Given the SOURCE-URL and WHEEL-URL of an already downloaded ARCHIVE, return -a pair of lists, each consisting of a list of name/variable pairs, for the -propagated inputs and the native inputs, respectively. Also -return the unaltered list of upstream dependency names." - - (define (strip-argparse deps) - (remove (cut string=? "argparse" <>) deps)) - - (define (requirement->package-name/sort deps) - (map string->symbol - (sort (map python->package-name deps) string-cipackage-name/sort strip-argparse)) - +the corresponding list of records." + (define (requirements->upstream-inputs deps type) + (filter-map (match-lambda + ("argparse" #f) + (name (upstream-input + (name name) + (downstream-name (python->package-name name)) + (type type)))) + (sort deps string-ci. (let ((dependencies (guess-requirements source-url wheel-url archive))) - (values (map process-requirements dependencies) - (concatenate dependencies)))) + (match dependencies + ((propagated native) + (append (requirements->upstream-inputs propagated 'propagated) + (requirements->upstream-inputs native 'native)))))) + +(define* (pypi-package-inputs pypi-package #:optional version) + "Return the list of for PYPI-PACKAGE. This procedure +downloads the source and possibly the wheel of PYPI-PACKAGE." + (let* ((info (pypi-project-info pypi-package)) + (version (or version (project-info-version info))) + (dist (source-release pypi-package version)) + (source-url (distribution-url dist)) + (wheel-url (and=> (wheel-release pypi-package version) + distribution-url))) + (call-with-temporary-output-file + (lambda (archive port) + (and (url-fetch source-url archive) + (compute-inputs source-url wheel-url archive)))))) (define (find-project-url name pypi-url) "Try different project name substitution until the result is found in @@ -445,52 +470,85 @@ (define (find-project-url name pypi-url) a substring of the PyPI URI that identifies the package.") pypi-url name)) name))) -(define (make-pypi-sexp name version source-url wheel-url home-page synopsis - description license) - "Return the `package' s-expression for a python package with the given NAME, -VERSION, SOURCE-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE." +(define* (pypi-package->upstream-source pypi-package #:optional version) + "Return the upstream source for the given VERSION of PYPI-PACKAGE, a + record. If VERSION is omitted or #f, use the latest version." + (let* ((info (pypi-project-info pypi-package)) + (version (or version (project-info-version info))) + (dist (source-release pypi-package version)) + (source-url (distribution-url dist)) + (wheel-url (and=> (wheel-release pypi-package version) + distribution-url))) + (let ((extra-inputs (if (string-suffix? ".zip" source-url) + (list (upstream-input + (name "zip") + (downstream-name "zip") + (type 'native))) + '()))) + (upstream-source + (urls (list source-url)) + (signature-urls + (if (distribution-has-signature? dist) + (list (string-append source-url ".asc")) + #f)) + (inputs (append (pypi-package-inputs pypi-package) + extra-inputs)) + (package (project-info-name info)) + (version version))))) + +(define* (make-pypi-sexp pypi-package + #:optional (version (latest-version pypi-package))) + "Return the `package' s-expression the given VERSION of PYPI-PACKAGE, a + record." (define (maybe-upstream-name name) (if (string-match ".*\\-[0-9]+" name) `((properties ,`'(("upstream-name" . ,name)))) '())) - - (call-with-temporary-output-file - (lambda (temp port) - (and (url-fetch source-url temp) - (receive (guix-dependencies upstream-dependencies) - (compute-inputs source-url wheel-url temp) - (match guix-dependencies - ((required-inputs native-inputs) - (when (string-suffix? ".zip" source-url) - (set! native-inputs (cons 'unzip native-inputs))) - (values - `(package - (name ,(python->package-name name)) - (version ,version) - (source - (origin - (method url-fetch) - (uri (pypi-uri - ,(find-project-url name source-url) - version - ;; Some packages have been released as `.zip` - ;; instead of the more common `.tar.gz`. For - ;; example, see "path-and-address". - ,@(if (string-suffix? ".zip" source-url) - '(".zip") - '()))) - (sha256 - (base32 - ,(guix-hash-url temp))))) - ,@(maybe-upstream-name name) - (build-system pyproject-build-system) - ,@(maybe-inputs required-inputs 'propagated-inputs) - ,@(maybe-inputs native-inputs 'native-inputs) - (home-page ,home-page) - (synopsis ,synopsis) - (description ,(beautify-description description)) - (license ,(license->symbol license))) - upstream-dependencies)))))))) + + (let* ((info (pypi-project-info pypi-package)) + (name (project-info-name info)) + (source-url (and=> (source-release pypi-package version) + distribution-url)) + (sha256 (and=> (source-release pypi-package version) + distribution-sha256)) + (source (pypi-package->upstream-source pypi-package version))) + (values + `(package + (name ,(python->package-name name)) + (version ,version) + (source + (origin + (method url-fetch) + (uri (pypi-uri + ,(find-project-url name source-url) + version + ;; Some packages have been released as `.zip` + ;; instead of the more common `.tar.gz`. For + ;; example, see "path-and-address". + ,@(if (string-suffix? ".zip" source-url) + '(".zip") + '()))) + (sha256 (base32 + ,(and=> (or sha256 + (let* ((port (http-fetch source-url)) + (hash (port-sha256 port))) + (close-port port) + hash)) + bytevector->nix-base32-string))))) + ,@(maybe-upstream-name name) + (build-system pyproject-build-system) + ,@(maybe-inputs (upstream-source-propagated-inputs source) + 'propagated-inputs) + ,@(maybe-inputs (upstream-source-native-inputs source) + 'native-inputs) + (home-page ,(project-info-home-page info)) + (synopsis ,(project-info-summary info)) + (description ,(beautify-description + (project-info-summary info))) + (license ,(license->symbol + (string->license + (project-info-license info))))) + (map upstream-input-name (upstream-source-inputs source))))) (define pypi->guix-package (memoize @@ -520,16 +578,7 @@ (define pypi->guix-package source. To build it from source, refer to the upstream repository at @uref{~a}.") url)))))))))))) - (make-pypi-sexp (project-info-name info) version - (and=> (source-release project version) - distribution-url) - (and=> (wheel-release project version) - distribution-url) - (project-info-home-page info) - (project-info-summary info) - (project-info-summary info) - (string->license - (project-info-license info)))) + (make-pypi-sexp project version)) (values #f '())))))) (define* (pypi-recursive-import package-name #:optional version) @@ -566,21 +615,7 @@ (define* (import-release package #:key (version #f)) (pypi-package (pypi-fetch pypi-name))) (and pypi-package (guard (c ((missing-source-error? c) #f)) - (let* ((info (pypi-project-info pypi-package)) - (version (or version (project-info-version info))) - (dist (source-release pypi-package version)) - (url (distribution-url dist))) - (upstream-source - (urls (list url)) - (signature-urls - (if (distribution-has-signature? dist) - (list (string-append url ".asc")) - #f)) - (input-changes - (changed-inputs package - (pypi->guix-package pypi-name #:version version))) - (package (package-name package)) - (version version))))))) + (pypi-package->upstream-source pypi-package version))))) (define %pypi-updater (upstream-updater diff --git a/guix/import/stackage.scm b/guix/import/stackage.scm index f98b86c334..f8b2726591 100644 --- a/guix/import/stackage.scm +++ b/guix/import/stackage.scm @@ -29,6 +29,7 @@ (define-module (guix import stackage) #:use-module (srfi srfi-35) #:use-module (guix import json) #:use-module (guix import hackage) + #:autoload (guix import cabal) (eval-cabal) #:use-module (guix import utils) #:use-module (guix memoization) #:use-module (guix packages) @@ -157,15 +158,13 @@ (define latest-lts-release (warning (G_ "failed to parse ~a~%") (hackage-cabal-url hackage-name)) #f) - (_ (let ((url (hackage-source-url hackage-name version))) + (_ (let ((url (hackage-source-url hackage-name version)) + (cabal (eval-cabal (hackage-fetch hackage-name) '()))) (upstream-source (package (package-name pkg)) (version version) (urls (list url)) - (input-changes - (changed-inputs - pkg - (stackage->guix-package hackage-name #:packages (packages)))))))))))) + (inputs (cabal-package-inputs cabal)))))))))) (define (stackage-lts-package? package) "Return whether PACKAGE is available on the default Stackage LTS release." diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm index 47c4d55ec4..e9e3eda9eb 100644 --- a/guix/scripts/refresh.scm +++ b/guix/scripts/refresh.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013-2022 Ludovic Courtès +;;; Copyright © 2013-2023 Ludovic Courtès ;;; Copyright © 2013 Nikita Karetnikov ;;; Copyright © 2014 Eric Bavier ;;; Copyright © 2015 Alex Kost @@ -401,7 +401,7 @@ (define* (update-package store package version updaters (('remove 'propagated) (info loc (G_ "~a: consider removing this propagated input: ~a~%") name change-name)))) - (upstream-source-input-changes source)) + (changed-inputs package source)) (let ((hash (file-hash* output))) (update-package-source package source hash))) (warning (G_ "~a: version ~a could not be \ diff --git a/guix/upstream.scm b/guix/upstream.scm index 52fae11832..6f2a4dca28 100644 --- a/guix/upstream.scm +++ b/guix/upstream.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2010-2022 Ludovic Courtès +;;; Copyright © 2010-2023 Ludovic Courtès ;;; Copyright © 2015 Alex Kost ;;; Copyright © 2019, 2022 Ricardo Wurmus ;;; Copyright © 2021 Sarah Morgensen @@ -55,7 +55,20 @@ (define-module (guix upstream) upstream-source-urls upstream-source-signature-urls upstream-source-archive-types - upstream-source-input-changes + upstream-source-inputs + + upstream-input-type-predicate + upstream-source-regular-inputs + upstream-source-native-inputs + upstream-source-propagated-inputs + + upstream-input + upstream-input? + upstream-input-name + upstream-input-downstream-name + upstream-input-type + upstream-input-min-version + upstream-input-max-version url-predicate url-prefix-predicate @@ -102,8 +115,40 @@ (define-record-type* (urls upstream-source-urls) ;list of strings|git-reference (signature-urls upstream-source-signature-urls ;#f | list of strings (default #f)) - (input-changes upstream-source-input-changes - (default '()) (thunked))) + (inputs upstream-source-inputs ;#f | list of + (delayed) (default #f))) ;delayed because optional and costly + +;; Representation of a dependency as expressed by upstream. +(define-record-type* + upstream-input make-upstream-input + upstream-input? + (name upstream-input-name) ;upstream package name + (downstream-name upstream-input-downstream-name) ;Guix package name + (type upstream-input-type ;'regular | 'native | 'propagated + (default 'regular)) + (min-version upstream-input-min-version + (default 'any)) + (max-version upstream-input-max-version + (default 'any))) + +(define (upstream-input-type-predicate type) + "Return a predicate that returns true when passed an record +of the given TYPE (a symbol such as 'propagated)." + (lambda (source) + (eq? type (upstream-input-type source)))) + +(define (input-type-filter type) + "Return a procedure that, given an , returns the subset of +its inputs that have the given TYPE (a symbol such as 'native)." + (lambda (source) + "Return the subset of inputs of SOURCE that have the given TYPE." + (filter (lambda (input) + (eq? type (upstream-input-type input))) + (upstream-source-inputs source)))) + +(define upstream-source-regular-inputs (input-type-filter 'regular)) +(define upstream-source-native-inputs (input-type-filter 'native)) +(define upstream-source-propagated-inputs (input-type-filter 'propagated)) ;; Representation of an upstream input change. (define-record-type* @@ -113,67 +158,55 @@ (define-record-type* (type upstream-input-change-type) ;symbol: regular | native | propagated (action upstream-input-change-action)) ;symbol: add | remove -(define (changed-inputs package package-sexp) - "Return a list of input changes for PACKAGE based on the newly imported -S-expression PACKAGE-SEXP." - (match package-sexp - ((and expr ('package fields ...)) - (let* ((input->name (match-lambda ((name pkg . out) name))) - (new-regular - (match expr - ((path *** ('inputs - ('quasiquote ((label ('unquote sym)) ...)))) label) - ((path *** ('inputs - ('list sym ...))) (map symbol->string sym)) - (_ '()))) - (new-native - (match expr - ((path *** ('native-inputs - ('quasiquote ((label ('unquote sym)) ...)))) label) - ((path *** ('native-inputs - ('list sym ...))) (map symbol->string sym)) - (_ '()))) - (new-propagated - (match expr - ((path *** ('propagated-inputs - ('quasiquote ((label ('unquote sym)) ...)))) label) - ((path *** ('propagated-inputs - ('list sym ...))) (map symbol->string sym)) - (_ '()))) - (current-regular - (map input->name (package-inputs package))) - (current-native - (map input->name (package-native-inputs package))) - (current-propagated - (map input->name (package-propagated-inputs package)))) - (append-map - (match-lambda - ((action type names) - (map (lambda (name) - (upstream-input-change - (name name) - (type type) - (action action))) - names))) - `((add regular - ,(lset-difference equal? - new-regular current-regular)) - (remove regular - ,(lset-difference equal? - current-regular new-regular)) - (add native - ,(lset-difference equal? - new-native current-native)) - (remove native - ,(lset-difference equal? - current-native new-native)) - (add propagated - ,(lset-difference equal? - new-propagated current-propagated)) - (remove propagated - ,(lset-difference equal? - current-propagated new-propagated)))))) - (_ '()))) +(define (changed-inputs package source) + "Return a list of input changes for PACKAGE compared to the 'inputs' field +of SOURCE, an record." + (define input->name + (match-lambda + ((label (? package? pkg) . out) (package-name pkg)) + (_ #f))) + + (if (upstream-source-inputs source) + (let* ((new-regular (map upstream-input-downstream-name + (upstream-source-regular-inputs source))) + (new-native (map upstream-input-downstream-name + (upstream-source-native-inputs source))) + (new-propagated (map upstream-input-downstream-name + (upstream-source-propagated-inputs source))) + (current-regular + (filter-map input->name (package-inputs package))) + (current-native + (filter-map input->name (package-native-inputs package))) + (current-propagated + (filter-map input->name (package-propagated-inputs package)))) + (append-map + (match-lambda + ((action type names) + (map (lambda (name) + (upstream-input-change + (name name) + (type type) + (action action))) + names))) + `((add regular + ,(lset-difference equal? + new-regular current-regular)) + (remove regular + ,(lset-difference equal? + current-regular new-regular)) + (add native + ,(lset-difference equal? + new-native current-native)) + (remove native + ,(lset-difference equal? + current-native new-native)) + (add propagated + ,(lset-difference equal? + new-propagated current-propagated)) + (remove propagated + ,(lset-difference equal? + current-propagated new-propagated))))) + '())) (define* (url-predicate matching-url?) "Return a predicate that returns true when passed a package whose source is diff --git a/tests/cran.scm b/tests/cran.scm index 5c820b1ab3..1ef533a41c 100644 --- a/tests/cran.scm +++ b/tests/cran.scm @@ -119,7 +119,7 @@ (define simple-alist ('build-system 'r-build-system) ('inputs ('list 'cairo)) ('propagated-inputs - ('list 'r-bh 'r-proto 'r-rcpp 'r-scales)) + ('list 'r-bh 'r-rcpp 'r-proto 'r-scales)) ('home-page "http://gnu.org/s/my-example") ('synopsis "Example package") ('description diff --git a/tests/pypi.scm b/tests/pypi.scm index 497744511f..f3b2771f4b 100644 --- a/tests/pypi.scm +++ b/tests/pypi.scm @@ -25,9 +25,12 @@ (define-module (test-pypi) #:use-module (guix base32) #:use-module (guix memoization) #:use-module (guix utils) + #:use-module ((guix base16) #:select (base16-string->bytevector)) + #:use-module (guix upstream) #:use-module (gcrypt hash) #:use-module (guix tests) #:use-module (guix tests http) + #:use-module ((guix download) #:select (url-fetch)) #:use-module (guix build-system python) #:use-module ((guix build utils) #:select (delete-file-recursively @@ -43,6 +46,12 @@ (define-module (test-pypi) #:use-module (ice-9 match) #:use-module (ice-9 optargs)) +(define default-sha256 + "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa") +(define default-sha256/base32 + (bytevector->nix-base32-string + (base16-string->bytevector default-sha256))) + (define* (foo-json #:key (name "foo") (name-in-url #f)) "Create a JSON description of an example pypi package, named @var{name}, optionally using a different @var{name in its URL}." @@ -65,7 +74,8 @@ (define* (foo-json #:key (name "foo") (name-in-url #f)) ((url . ,(format #f "~a/~a-1.0.0.tar.gz" (%local-url #:path "") (or name-in-url name))) - (packagetype . "sdist")) + (packagetype . "sdist") + (digests . (("sha256" . ,default-sha256)))) ((url . ,(format #f "~a/~a-1.0.0-py2.py3-none-any.whl" (%local-url #:path "") (or name-in-url name))) @@ -308,9 +318,7 @@ (define-syntax-rule (with-pypi responses body ...) ('synopsis "summary") ('description "summary") ('license 'license:lgpl2.0)) - (and (string=? (bytevector->nix-base32-string - (file-sha256 tarball)) - hash) + (and (string=? default-sha256/base32 hash) (equal? (pypi->guix-package "foo" #:version "1.0.0") (pypi->guix-package "foo")) (guard (c ((error? c) #t)) @@ -352,8 +360,7 @@ (define-syntax-rule (with-pypi responses body ...) ('synopsis "summary") ('description "summary") ('license 'license:lgpl2.0)) - (string=? (bytevector->nix-base32-string (file-sha256 tarball)) - hash)) + (string=? default-sha256/base32 hash)) (x (pk 'fail x #f)))))) @@ -382,8 +389,7 @@ (define-syntax-rule (with-pypi responses body ...) ('synopsis "summary") ('description "summary") ('license 'license:lgpl2.0)) - (string=? (bytevector->nix-base32-string (file-sha256 tarball)) - hash)) + (string=? default-sha256/base32 hash)) (x (pk 'fail x #f)))))) @@ -414,11 +420,47 @@ (define-syntax-rule (with-pypi responses body ...) ('synopsis "summary") ('description "summary") ('license 'license:lgpl2.0)) - (string=? (bytevector->nix-base32-string (file-sha256 tarball)) - hash)) + (string=? default-sha256/base32 hash)) (x (pk 'fail x #f)))))) +(test-equal "package-latest-release" + (list '("foo-1.0.0.tar.gz") + '("foo-1.0.0.tar.gz.asc") + (list (upstream-input + (name "bar") + (downstream-name "python-bar") + (type 'propagated)) + (upstream-input + (name "foo") + (downstream-name "python-foo") + (type 'propagated)) + (upstream-input + (name "pytest") + (downstream-name "python-pytest") + (type 'native)))) + (let ((tarball (pypi-tarball + "foo-1.0.0" + `(("src/bizarre.egg-info/requires.txt" + ,test-requires.txt))))) + (with-pypi `(("/foo-1.0.0.tar.gz" 200 ,(file-dump tarball)) + ("/foo-1.0.0-py2.py3-none-any.whl" 404 "") + ("/foo/json" 200 ,(lambda (port) + (display (foo-json) port)))) + (define source + (package-latest-release + (dummy-package "python-foo" + (version "0.1.2") + (source (dummy-origin + (method url-fetch) + (uri (pypi-uri "foo" version)))) + (build-system python-build-system)) + (list %pypi-updater))) + + (list (map basename (upstream-source-urls source)) + (map basename (upstream-source-signature-urls source)) + (upstream-source-inputs source))))) + (test-end "pypi") (delete-file-recursively sample-directory) diff --git a/tests/upstream.scm b/tests/upstream.scm index 9aacb77229..0792ebd5d0 100644 --- a/tests/upstream.scm +++ b/tests/upstream.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016 Ludovic Courtès +;;; Copyright © 2016, 2023 Ludovic Courtès ;;; Copyright © 2022 Ricardo Wurmus ;;; ;;; This file is part of GNU Guix. @@ -78,69 +78,29 @@ (define test-package (description "test") (license license:gpl3+))) -(define test-package-sexp - '(package - (name "test") - (version "2.10") - (source (origin - (method url-fetch) - (uri (string-append "mirror://gnu/hello/hello-" version - ".tar.gz")) - (sha256 - (base32 - "0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i")))) - (build-system gnu-build-system) - (inputs - `(("hello" ,hello))) - (native-inputs - `(("sed" ,sed) - ("tar" ,tar))) - (propagated-inputs - `(("grep" ,grep))) - (home-page "http://localhost") - (synopsis "test") - (description "test") - (license license:gpl3+))) - (test-equal "changed-inputs returns no changes" '() - (changed-inputs test-package test-package-sexp)) - -(test-assert "changed-inputs returns changes to labelled input list" - (let ((changes (changed-inputs - (package - (inherit test-package) - (inputs `(("hello" ,hello) - ("sed" ,sed)))) - test-package-sexp))) - (match changes - ;; Exactly one change - (((? upstream-input-change? item)) - (and (equal? (upstream-input-change-type item) - 'regular) - (equal? (upstream-input-change-action item) - 'remove) - (string=? (upstream-input-change-name item) - "sed"))) - (else (pk else #false))))) - -(test-assert "changed-inputs returns changes to all labelled input lists" - (let ((changes (changed-inputs - (package - (inherit test-package) - (inputs '()) - (native-inputs '()) - (propagated-inputs '())) - test-package-sexp))) - (match changes - (((? upstream-input-change? items) ...) - (and (equal? (map upstream-input-change-type items) - '(regular native native propagated)) - (equal? (map upstream-input-change-action items) - '(add add add add)) - (equal? (map upstream-input-change-name items) - '("hello" "sed" "tar" "grep")))) - (else (pk else #false))))) + (changed-inputs test-package + (upstream-source + (package "test") + (version "1") + (urls '()) + (inputs + (let ((->input + (lambda (type) + (match-lambda + ((label _) + (upstream-input + (name label) + (downstream-name label) + (type type))))))) + (append (map (->input 'regular) + (package-inputs test-package)) + (map (->input 'native) + (package-native-inputs test-package)) + (map (->input 'propagated) + (package-propagated-inputs + test-package)))))))) (define test-new-package (package @@ -152,35 +112,20 @@ (define test-new-package (propagated-inputs (list grep)))) -(define test-new-package-sexp - '(package - (name "test") - (version "2.10") - (source (origin - (method url-fetch) - (uri (string-append "mirror://gnu/hello/hello-" version - ".tar.gz")) - (sha256 - (base32 - "0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i")))) - (build-system gnu-build-system) - (inputs - (list hello)) - (native-inputs - (list sed tar)) - (propagated-inputs - (list grep)) - (home-page "http://localhost") - (synopsis "test") - (description "test") - (license license:gpl3+))) - (test-assert "changed-inputs returns changes to plain input list" (let ((changes (changed-inputs (package (inherit test-new-package) - (inputs (list hello sed))) - test-new-package-sexp))) + (inputs (list hello sed)) + (native-inputs '()) + (propagated-inputs '())) + (upstream-source + (package "test") + (version "1") + (urls '()) + (inputs (list (upstream-input + (name "hello") + (downstream-name name)))))))) (match changes ;; Exactly one change (((? upstream-input-change? item)) @@ -199,7 +144,26 @@ (define test-new-package-sexp (inputs '()) (native-inputs '()) (propagated-inputs '())) - test-new-package-sexp))) + (upstream-source + (package "test") + (version "1") + (urls '()) + (inputs (list (upstream-input + (name "hello") + (downstream-name name) + (type 'regular)) + (upstream-input + (name "sed") + (downstream-name name) + (type 'native)) + (upstream-input + (name "tar") + (downstream-name name) + (type 'native)) + (upstream-input + (name "grep") + (downstream-name name) + (type 'propagated)))))))) (match changes (((? upstream-input-change? items) ...) (and (equal? (map upstream-input-change-type items) From patchwork Thu May 18 15:16:15 2023 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: 50112 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 0672017A9A; Thu, 18 May 2023 16:17:56 +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=-3.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H2,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 54D2E17A6F for ; Thu, 18 May 2023 16:17:55 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pzfNZ-0003aX-Be; Thu, 18 May 2023 11:17:22 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pzfNO-0003KS-1i for guix-patches@gnu.org; Thu, 18 May 2023 11:17:11 -0400 Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1pzfNM-0001yr-PN; Thu, 18 May 2023 11:17:09 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pzfNI-0005U7-0U; Thu, 18 May 2023 11:17:04 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#63571] [PATCH 07/14] diagnostics: Factorize 'absolute-location'. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: mail@cbaines.net, dev@jpoiret.xyz, ludo@gnu.org, othacehe@gnu.org, rekado@elephly.net, zimon.toutoune@gmail.com, me@tobias.gr, guix-patches@gnu.org Resent-Date: Thu, 18 May 2023 15:17:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 63571 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 63571@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= , Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice X-Debbugs-Original-Xcc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Received: via spool by 63571-submit@debbugs.gnu.org id=B63571.168442301421003 (code B ref 63571); Thu, 18 May 2023 15:17:03 +0000 Received: (at 63571) by debbugs.gnu.org; 18 May 2023 15:16:54 +0000 Received: from localhost ([127.0.0.1]:54124 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pzfN8-0005Sb-21 for submit@debbugs.gnu.org; Thu, 18 May 2023 11:16:54 -0400 Received: from eggs.gnu.org ([209.51.188.92]:55656) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pzfMy-0005QU-CH for 63571@debbugs.gnu.org; Thu, 18 May 2023 11:16:45 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pzfMt-0001vQ-6L; Thu, 18 May 2023 11:16:39 -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=SdbfEdQYGJSe7HirGcp0UVp/kervV8q1evm4RQ5/DTs=; b=GQpQrjZ+2JNBvmrpAZc4 /8h28w84oIAR3ZgT2Nfz1bvVdfiwXswRrM9LB98oXg3X/ow23JXdK/j/5+GF+/uB5TnZErTAv55oQ xfZxPVWwi5PQ+e67QBzwoJX5F4H3r+3Z66jqA9MZ8ekYvE6H0/+uVOooE8KaAb6/0NcEVRnyKi52Z AIj1QhKsZO8Y3zmk8g0PpRMyfEU16+/UM+4VaLFLGyYrf2c4JwIcNwtshL4iTSSwEZ5SZsZsNAhO3 p4F3omEXXG2bdjYbaqacngwY85aezQKSOhCs55+fL19+pAG7IcGYwi6/t67/43F1peqE3nSJOxIKZ dpd4f0jVt3AzjA==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201] helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pzfMs-0007G6-PJ; Thu, 18 May 2023 11:16:38 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Thu, 18 May 2023 17:16:15 +0200 Message-Id: <435ffbe3922c46f3e55bfe607f0f8e7a5dd4aa1b.1684421460.git.ludo@gnu.org> X-Mailer: git-send-email 2.40.1 In-Reply-To: References: 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-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches * guix/scripts/style.scm (absolute-location): Move to... * guix/diagnostics.scm (absolute-location): ... here. * guix/upstream.scm (update-package-source): Use it. --- guix/diagnostics.scm | 20 +++++++++++++++++++- guix/scripts/style.scm | 17 ----------------- guix/upstream.scm | 4 ++-- 3 files changed, 21 insertions(+), 20 deletions(-) diff --git a/guix/diagnostics.scm b/guix/diagnostics.scm index 9f0d558f2f..3f1f527b43 100644 --- a/guix/diagnostics.scm +++ b/guix/diagnostics.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès +;;; Copyright © 2012-2021, 2023 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -36,6 +36,7 @@ (define-module (guix diagnostics) location-file location-line location-column + absolute-location source-properties->location location->source-properties location->string @@ -340,6 +341,23 @@ (define-syntax formatted-message (&formatted-message (format str) (arguments (list args ...)))))))))) +(define (absolute-location loc) + "Replace the file name in LOC by an absolute location." + (location (if (string-prefix? "/" (location-file loc)) + (location-file loc) + + ;; 'search-path' might return #f in obscure cases, such as + ;; when %LOAD-PATH includes "." or ".." and LOC comes from a + ;; file in a subdirectory thereof. + (match (search-path %load-path (location-file loc)) + (#f + (raise (formatted-message + (G_ "file '~a' not found on load path") + (location-file loc)))) + (str str))) + (location-line loc) + (location-column loc))) + (define guix-warning-port (make-parameter (current-warning-port))) diff --git a/guix/scripts/style.scm b/guix/scripts/style.scm index 00c7d3f90c..3f5d757e10 100644 --- a/guix/scripts/style.scm +++ b/guix/scripts/style.scm @@ -225,23 +225,6 @@ (define (edit-expression/dry-run properties rewrite-string) (G_ "would be edited~%"))) str))) -(define (absolute-location loc) - "Replace the file name in LOC by an absolute location." - (location (if (string-prefix? "/" (location-file loc)) - (location-file loc) - - ;; 'search-path' might return #f in obscure cases, such as - ;; when %LOAD-PATH includes "." or ".." and LOC comes from a - ;; file in a subdirectory thereof. - (match (search-path %load-path (location-file loc)) - (#f - (raise (formatted-message - (G_ "file '~a' not found on load path") - (location-file loc)))) - (str str))) - (location-line loc) - (location-column loc))) - (define (trivial-package-arguments? package) "Return true if PACKAGE has zero arguments or only \"trivial\" arguments guaranteed not to refer to input labels." diff --git a/guix/upstream.scm b/guix/upstream.scm index 6f2a4dca28..29dd923e63 100644 --- a/guix/upstream.scm +++ b/guix/upstream.scm @@ -630,8 +630,8 @@ (define* (update-package-source package source hash) ;; function of the person who uploads the package. Note that ;; package definitions usually concatenate fragments of the URL, ;; which is why we only attempt to replace a subset of the URL. - (let ((properties (assq-set! (location->source-properties loc) - 'filename file)) + (let ((properties (location->source-properties + (absolute-location loc))) (replacements `((,old-version . ,version) (,old-hash . ,hash) ,@(if (and old-commit new-commit) From patchwork Thu May 18 15:16:16 2023 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: 50109 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 B4AA917A9A; Thu, 18 May 2023 16:17:33 +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=-3.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H2,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 9C36C17A88 for ; Thu, 18 May 2023 16:17:32 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pzfNY-0003Zv-Vz; Thu, 18 May 2023 11:17:21 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pzfNO-0003KT-1l for guix-patches@gnu.org; Thu, 18 May 2023 11:17:11 -0400 Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1pzfNK-0001yi-Ce; Thu, 18 May 2023 11:17:07 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pzfNI-0005UE-Dr; Thu, 18 May 2023 11:17:04 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#63571] [PATCH 08/14] upstream: 'update-package-source' edits input fields. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: mail@cbaines.net, dev@jpoiret.xyz, ludo@gnu.org, othacehe@gnu.org, rekado@elephly.net, zimon.toutoune@gmail.com, me@tobias.gr, guix-patches@gnu.org Resent-Date: Thu, 18 May 2023 15:17:04 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 63571 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 63571@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= , Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice X-Debbugs-Original-Xcc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Received: via spool by 63571-submit@debbugs.gnu.org id=B63571.168442301521011 (code B ref 63571); Thu, 18 May 2023 15:17:04 +0000 Received: (at 63571) by debbugs.gnu.org; 18 May 2023 15:16:55 +0000 Received: from localhost ([127.0.0.1]:54126 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pzfN8-0005Si-HJ for submit@debbugs.gnu.org; Thu, 18 May 2023 11:16:55 -0400 Received: from eggs.gnu.org ([209.51.188.92]:55662) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pzfMz-0005QZ-6V for 63571@debbugs.gnu.org; Thu, 18 May 2023 11:16:46 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pzfMu-0001vb-0L; Thu, 18 May 2023 11:16:40 -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=TLXn+Xhl7b/LOtknN2RpptC2J87JZBjB6dlRrdQOwCA=; b=FMIRVETiBImcQWobl/FH IF6Os8NexHlQPf7iLNO1Iy6bOceE8P0neqPR58fhcefBmQKI5CLtkp5uGXXA6zpX3uC9xuSIsGn99 tnleKNuEsDImGUy7gT5VoEaQxoTSjg9a37o8R2xogGJwmP0jHtkWhKzVlZBC0H38NDWAWfdRoPSQD hDEG4/m4i9RWQkfFUVXSwFCw7AenWZifn0CIFLvzCohuJzZzep/W4i9tVEt+lbYiiOuairbBLPKva 1dAsy/zEOpccj/Fnb/QonwtEPaWfDEsdt25tHzH853bqvrK2sswQwaTUsDDZdV30aYOEZjpLHR0Fk InTfrs032OUErg==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201] helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pzfMt-0007G6-K2; Thu, 18 May 2023 11:16:39 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Thu, 18 May 2023 17:16:16 +0200 Message-Id: X-Mailer: git-send-email 2.40.1 In-Reply-To: References: 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-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches Previously, 'guix refresh r-ggplot2 -u' and similar commands would print of list of input changes that would have to be made manually. With this change, 'guix refresh -u' takes care of updating input fields automatically. * guix/upstream.scm (update-package-inputs): New procedure. (update-package-source): Call it when 'upstream-source-inputs' returns true. * guix/scripts/refresh.scm (update-package): Remove iteration over the result of 'changed-inputs'. * guix/import/test.scm (available-updates): Add support for input lists. * tests/guix-refresh.sh (GUIX_TEST_UPDATER_TARGETS): Add input list for "the-test-package". Make sure 'guix refresh -u' updates 'inputs' accordingly. --- guix/import/test.scm | 13 +++++++++- guix/scripts/refresh.scm | 36 -------------------------- guix/upstream.scm | 56 +++++++++++++++++++++++++++++++++++++--- tests/guix-refresh.sh | 7 +++-- 4 files changed, 69 insertions(+), 43 deletions(-) diff --git a/guix/import/test.scm b/guix/import/test.scm index b1ed0b455d..4bd356bddc 100644 --- a/guix/import/test.scm +++ b/guix/import/test.scm @@ -52,7 +52,18 @@ (define (available-updates package) (upstream-source (package (package-name package)) (version version) - (urls (list url))))) + (urls (list url)))) + ((version url (inputs ...)) + (upstream-source + (package (package-name package)) + (version version) + (urls (list url)) + (inputs + (map (lambda (name) + (upstream-input + (name name) + (downstream-name name))) + inputs))))) updates) result) result)))) diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm index e9e3eda9eb..7d74729a88 100644 --- a/guix/scripts/refresh.scm +++ b/guix/scripts/refresh.scm @@ -366,42 +366,6 @@ (define* (update-package store package version updaters (G_ "~a: updating from version ~a to version ~a...~%") (package-name package) (package-version package) version) - (for-each - (lambda (change) - (define field - (match (upstream-input-change-type change) - ('native 'native-inputs) - ('propagated 'propagated-inputs) - (_ 'inputs))) - - (define name - (package-name package)) - (define loc - (package-field-location package field)) - (define change-name - (upstream-input-change-name change)) - - (match (list (upstream-input-change-action change) - (upstream-input-change-type change)) - (('add 'regular) - (info loc (G_ "~a: consider adding this input: ~a~%") - name change-name)) - (('add 'native) - (info loc (G_ "~a: consider adding this native input: ~a~%") - name change-name)) - (('add 'propagated) - (info loc (G_ "~a: consider adding this propagated input: ~a~%") - name change-name)) - (('remove 'regular) - (info loc (G_ "~a: consider removing this input: ~a~%") - name change-name)) - (('remove 'native) - (info loc (G_ "~a: consider removing this native input: ~a~%") - name change-name)) - (('remove 'propagated) - (info loc (G_ "~a: consider removing this propagated input: ~a~%") - name change-name)))) - (changed-inputs package source)) (let ((hash (file-hash* output))) (update-package-source package source hash))) (warning (G_ "~a: version ~a could not be \ diff --git a/guix/upstream.scm b/guix/upstream.scm index 29dd923e63..1a90a342ff 100644 --- a/guix/upstream.scm +++ b/guix/upstream.scm @@ -38,6 +38,7 @@ (define-module (guix upstream) #:use-module (guix hash) #:use-module (guix store) #:use-module ((guix derivations) #:select (built-derivations derivation->output-path)) + #:autoload (guix read-print) (object->string*) #:autoload (gcrypt hash) (port-sha256) #:use-module (guix monads) #:use-module (srfi srfi-1) @@ -576,6 +577,52 @@ (define* (package-update store package (package-name package))) (values #f #f #f)))) +(define (update-package-inputs package source) + "Update the input fields of the definition of PACKAGE according to those +specified in SOURCE, an ." + (define (update-field field source-inputs package-inputs) + (define loc + (package-field-location package field)) + + (define new + (map (compose string->symbol upstream-input-downstream-name) + (source-inputs source))) + + (define old + (match (package-inputs package) + (((labels (? package? packages)) ...) + labels) + (_ + '()))) + + (define unchanged? + (equal? new old)) + + (if (and loc (not unchanged?)) + (edit-expression (location->source-properties + (absolute-location loc)) + (lambda (str) + (object->string* `(list ,@new) + (location-column loc)))) + (unless unchanged? + ;; XXX: Bail out when FIELD isn't already present in the source. + ;; TODO: Add the field if it's missing. + (warning (package-location package) + (G_ "~a: '~a' field not found; leaving it unchanged~%") + (package-name package) field) + (warning (package-location package) + (G_ "~a: expected '~a' value: ~s~%") + (package-name package) field new)))) + + (for-each update-field + '(inputs native-inputs propagated-inputs) + (list upstream-source-regular-inputs + upstream-source-native-inputs + upstream-source-propagated-inputs) + (list package-inputs + package-native-inputs + package-propagated-inputs))) + (define* (update-package-source package source hash) "Modify the source file that defines PACKAGE to refer to SOURCE, an whose tarball has SHA256 HASH (a bytevector). Return the @@ -630,9 +677,7 @@ (define* (update-package-source package source hash) ;; function of the person who uploads the package. Note that ;; package definitions usually concatenate fragments of the URL, ;; which is why we only attempt to replace a subset of the URL. - (let ((properties (location->source-properties - (absolute-location loc))) - (replacements `((,old-version . ,version) + (let ((replacements `((,old-version . ,version) (,old-hash . ,hash) ,@(if (and old-commit new-commit) `((,old-commit . ,new-commit)) @@ -641,8 +686,11 @@ (define* (update-package-source package source hash) `((,(dirname old-url) . ,(dirname new-url))) '())))) - (and (edit-expression properties + (and (edit-expression (location->source-properties + (absolute-location loc)) (cut update-expression <> replacements)) + (or (not (upstream-source-inputs source)) + (update-package-inputs package source)) version)) (begin (warning (G_ "~a: could not locate source file") diff --git a/tests/guix-refresh.sh b/tests/guix-refresh.sh index 691020b031..9d7a57a36e 100644 --- a/tests/guix-refresh.sh +++ b/tests/guix-refresh.sh @@ -34,7 +34,8 @@ GUIX_TEST_UPDATER_TARGETS=' ("1.6.4" "file:///dev/null"))) ("libreoffice" "" (("1.0" "file:///dev/null"))) ("idutils" "" (("'$idutils_version'" "file:///dev/null"))) - ("the-test-package" "" (("5.5" "file://'$PWD/$module_dir'/source"))))' + ("the-test-package" "" (("5.5" "file://'$PWD/$module_dir'/source" + ("grep" "sed")))))' # No newer version available. guix refresh -t test idutils # XXX: should return non-zero? @@ -91,13 +92,15 @@ cat > "$module_dir/sample.scm"< X-Patchwork-Id: 50115 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 C24BC17A88; Thu, 18 May 2023 16:18:16 +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=-3.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H2,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 D008E17A9A for ; Thu, 18 May 2023 16:18:15 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pzfNV-0003Vg-Kp; Thu, 18 May 2023 11:17:17 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pzfNN-0003KR-WE for guix-patches@gnu.org; Thu, 18 May 2023 11:17:11 -0400 Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1pzfNL-0001yl-Bk; Thu, 18 May 2023 11:17:08 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pzfNI-0005UK-SV; Thu, 18 May 2023 11:17:04 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#63571] [PATCH 09/14] upstream: Remove and related code. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: mail@cbaines.net, dev@jpoiret.xyz, ludo@gnu.org, othacehe@gnu.org, rekado@elephly.net, zimon.toutoune@gmail.com, me@tobias.gr, guix-patches@gnu.org Resent-Date: Thu, 18 May 2023 15:17:04 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 63571 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 63571@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= , Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice X-Debbugs-Original-Xcc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Received: via spool by 63571-submit@debbugs.gnu.org id=B63571.168442301621018 (code B ref 63571); Thu, 18 May 2023 15:17:04 +0000 Received: (at 63571) by debbugs.gnu.org; 18 May 2023 15:16:56 +0000 Received: from localhost ([127.0.0.1]:54128 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pzfN9-0005Sq-8H for submit@debbugs.gnu.org; Thu, 18 May 2023 11:16:55 -0400 Received: from eggs.gnu.org ([209.51.188.92]:55664) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pzfN0-0005Qb-0s for 63571@debbugs.gnu.org; Thu, 18 May 2023 11:16:47 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pzfMu-0001vo-RC; Thu, 18 May 2023 11:16:40 -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=pDY1XX+UFrepPdlVcRDrBmOfjRRGXt4CMRppEK82J8w=; b=Z26vjalJbwBOD0v+5Ncq ICNwINulN4J/iq5XDdoR9kUFp1QGF/LTX4HrwCKzyMimHrqAhXuX8AWINFjd2IrzLtj2sPdTaujK7 YES2RTvC5gE/xaU/QsvgpZKtUeejR8oLcZmgYEtDTQZKuCgmdvV0buTBCDVmgxIixJO3EuhxO+0Qf xM62IioXQ+Zrg953i7LwKmeMQfb6b/dJh0m9qVuu0oUaWL1tNZ9wMbjRVC5mY5gRxhT+YD+u7jNra SZ5UYY6iTwt5M7Zp7sGOlwg/g4q7wu/meQGIjzN+zi4G1ySbrPrSxInjZdCcbyXHUN2/T92bLJBg5 HGpmiLc6vegT7A==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201] helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pzfMu-0007G6-ES; Thu, 18 May 2023 11:16:40 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Thu, 18 May 2023 17:16:17 +0200 Message-Id: X-Mailer: git-send-email 2.40.1 In-Reply-To: References: 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-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches * guix/upstream.scm (): Remove. (changed-inputs): Remove. * tests/upstream.scm (test-package, test-new-package) ("changed-inputs returns no changes") ("changed-inputs returns changes to plain input list") ("changed-inputs returns changes to all plain input lists"): Remove. --- guix/upstream.scm | 64 ------------------------ tests/upstream.scm | 120 --------------------------------------------- 2 files changed, 184 deletions(-) diff --git a/guix/upstream.scm b/guix/upstream.scm index 1a90a342ff..54e6c3b89c 100644 --- a/guix/upstream.scm +++ b/guix/upstream.scm @@ -82,12 +82,6 @@ (define-module (guix upstream) upstream-updater-predicate upstream-updater-import - upstream-input-change? - upstream-input-change-name - upstream-input-change-type - upstream-input-change-action - changed-inputs - %updaters lookup-updater @@ -151,64 +145,6 @@ (define upstream-source-regular-inputs (input-type-filter 'regular)) (define upstream-source-native-inputs (input-type-filter 'native)) (define upstream-source-propagated-inputs (input-type-filter 'propagated)) -;; Representation of an upstream input change. -(define-record-type* - upstream-input-change make-upstream-input-change - upstream-input-change? - (name upstream-input-change-name) ;string - (type upstream-input-change-type) ;symbol: regular | native | propagated - (action upstream-input-change-action)) ;symbol: add | remove - -(define (changed-inputs package source) - "Return a list of input changes for PACKAGE compared to the 'inputs' field -of SOURCE, an record." - (define input->name - (match-lambda - ((label (? package? pkg) . out) (package-name pkg)) - (_ #f))) - - (if (upstream-source-inputs source) - (let* ((new-regular (map upstream-input-downstream-name - (upstream-source-regular-inputs source))) - (new-native (map upstream-input-downstream-name - (upstream-source-native-inputs source))) - (new-propagated (map upstream-input-downstream-name - (upstream-source-propagated-inputs source))) - (current-regular - (filter-map input->name (package-inputs package))) - (current-native - (filter-map input->name (package-native-inputs package))) - (current-propagated - (filter-map input->name (package-propagated-inputs package)))) - (append-map - (match-lambda - ((action type names) - (map (lambda (name) - (upstream-input-change - (name name) - (type type) - (action action))) - names))) - `((add regular - ,(lset-difference equal? - new-regular current-regular)) - (remove regular - ,(lset-difference equal? - current-regular new-regular)) - (add native - ,(lset-difference equal? - new-native current-native)) - (remove native - ,(lset-difference equal? - current-native new-native)) - (add propagated - ,(lset-difference equal? - new-propagated current-propagated)) - (remove propagated - ,(lset-difference equal? - current-propagated new-propagated))))) - '())) - (define* (url-predicate matching-url?) "Return a predicate that returns true when passed a package whose source is an with the URL-FETCH method, and one of its URLs passes diff --git a/tests/upstream.scm b/tests/upstream.scm index 0792ebd5d0..b82579228a 100644 --- a/tests/upstream.scm +++ b/tests/upstream.scm @@ -54,124 +54,4 @@ (define-module (test-upstream) (signature-urls '("ftp://example.org/foo-1.tar.xz.sig")))))) -(define test-package - (package - (name "test") - (version "2.10") - (source (origin - (method url-fetch) - (uri (string-append "mirror://gnu/hello/hello-" version - ".tar.gz")) - (sha256 - (base32 - "0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i")))) - (build-system gnu-build-system) - (inputs - `(("hello" ,hello))) - (native-inputs - `(("sed" ,sed) - ("tar" ,tar))) - (propagated-inputs - `(("grep" ,grep))) - (home-page "http://localhost") - (synopsis "test") - (description "test") - (license license:gpl3+))) - -(test-equal "changed-inputs returns no changes" - '() - (changed-inputs test-package - (upstream-source - (package "test") - (version "1") - (urls '()) - (inputs - (let ((->input - (lambda (type) - (match-lambda - ((label _) - (upstream-input - (name label) - (downstream-name label) - (type type))))))) - (append (map (->input 'regular) - (package-inputs test-package)) - (map (->input 'native) - (package-native-inputs test-package)) - (map (->input 'propagated) - (package-propagated-inputs - test-package)))))))) - -(define test-new-package - (package - (inherit test-package) - (inputs - (list hello)) - (native-inputs - (list sed tar)) - (propagated-inputs - (list grep)))) - -(test-assert "changed-inputs returns changes to plain input list" - (let ((changes (changed-inputs - (package - (inherit test-new-package) - (inputs (list hello sed)) - (native-inputs '()) - (propagated-inputs '())) - (upstream-source - (package "test") - (version "1") - (urls '()) - (inputs (list (upstream-input - (name "hello") - (downstream-name name)))))))) - (match changes - ;; Exactly one change - (((? upstream-input-change? item)) - (and (equal? (upstream-input-change-type item) - 'regular) - (equal? (upstream-input-change-action item) - 'remove) - (string=? (upstream-input-change-name item) - "sed"))) - (else (pk else #false))))) - -(test-assert "changed-inputs returns changes to all plain input lists" - (let ((changes (changed-inputs - (package - (inherit test-new-package) - (inputs '()) - (native-inputs '()) - (propagated-inputs '())) - (upstream-source - (package "test") - (version "1") - (urls '()) - (inputs (list (upstream-input - (name "hello") - (downstream-name name) - (type 'regular)) - (upstream-input - (name "sed") - (downstream-name name) - (type 'native)) - (upstream-input - (name "tar") - (downstream-name name) - (type 'native)) - (upstream-input - (name "grep") - (downstream-name name) - (type 'propagated)))))))) - (match changes - (((? upstream-input-change? items) ...) - (and (equal? (map upstream-input-change-type items) - '(regular native native propagated)) - (equal? (map upstream-input-change-action items) - '(add add add add)) - (equal? (map upstream-input-change-name items) - '("hello" "sed" "tar" "grep")))) - (else (pk else #false))))) - (test-end) From patchwork Thu May 18 15:16:18 2023 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: 50113 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 0DF2F27BBE2; Thu, 18 May 2023 16:18:06 +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=-3.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H2,SPF_HELO_PASS, URIBL_BLOCKED autolearn=ham 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 7A79E17A6F for ; Thu, 18 May 2023 16:18:05 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pzfNh-0003ez-0j; Thu, 18 May 2023 11:17:29 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pzfNJ-0003KC-MU for guix-patches@gnu.org; Thu, 18 May 2023 11:17:11 -0400 Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1pzfNJ-0001yb-Dh for guix-patches@gnu.org; Thu, 18 May 2023 11:17:05 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pzfNJ-0005UU-9Y for guix-patches@gnu.org; Thu, 18 May 2023 11:17:05 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#63571] [PATCH 10/14] tests: upstream: Restore test that was skipped. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 18 May 2023 15:17:05 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 63571 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 63571@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 63571-submit@debbugs.gnu.org id=B63571.168442301621025 (code B ref 63571); Thu, 18 May 2023 15:17:05 +0000 Received: (at 63571) by debbugs.gnu.org; 18 May 2023 15:16:56 +0000 Received: from localhost ([127.0.0.1]:54130 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pzfNA-0005Sx-0a for submit@debbugs.gnu.org; Thu, 18 May 2023 11:16:56 -0400 Received: from eggs.gnu.org ([209.51.188.92]:55666) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pzfN0-0005Qd-Ri for 63571@debbugs.gnu.org; Thu, 18 May 2023 11:16:47 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pzfMv-0001vv-LR; Thu, 18 May 2023 11:16:41 -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=fOHBE1IFLZ7OiJkXP7oWiJN1CSAmLviMfv/zd8cpwYY=; b=QqkLyrDKQ+MbGmfBfEdL zCIN1xEldbAkVsTQBqOkwX9Ti57BE4fpVKDqwYyTwFynQztt88TTgZq2vyha6Yy87erCnBRPsANvT SF6dUgnI2KeBAtbSi8cqmBmeYSl1EduhP6LbrkV33Sl8AvEiC3kumJtTXoV2v4PwohrbSaG3g04v1 A0BhuAeHMz+vI9H64J50XeFuMdz516NtvJBGGv/jTMlA+qgSQ3HdOIHnbTtczCegD6ZNmgsinh2bX MN+cXUnmMVUNOv+uSAVvNhnnPcjHET5TPQPEv0FyZrajMEaV/2xSMIvO6urDAeDU3YBh6rQyj80rz mtcNSmrfRsKhzg==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201] helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pzfMv-0007G6-8p; Thu, 18 May 2023 11:16:41 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Thu, 18 May 2023 17:16:18 +0200 Message-Id: <4b4364fda21d0ff3dc4657567dca4b47f6af4ec8.1684421460.git.ludo@gnu.org> X-Mailer: git-send-email 2.40.1 In-Reply-To: References: 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-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches This test was being skipped since ea6fb108f6a3a53d48ea187b1f82b5f7ffce00a7. * tests/upstream.scm ("coalesce-sources same version"): Compare a serialized form of . --- tests/upstream.scm | 39 ++++++++++++++++++++------------------- 1 file changed, 20 insertions(+), 19 deletions(-) diff --git a/tests/upstream.scm b/tests/upstream.scm index b82579228a..a94bb66068 100644 --- a/tests/upstream.scm +++ b/tests/upstream.scm @@ -32,26 +32,27 @@ (define-module (test-upstream) (test-begin "upstream") -;; FIXME: Temporarily skipping this test; see . -(test-skip 1) - (test-equal "coalesce-sources same version" - (list (upstream-source - (package "foo") (version "1") - (urls '("ftp://example.org/foo-1.tar.xz" - "ftp://example.org/foo-1.tar.gz")) - (signature-urls '("ftp://example.org/foo-1.tar.xz.sig" - "ftp://example.org/foo-1.tar.gz.sig")))) + '((source "foo" "1" + ("ftp://example.org/foo-1.tar.xz" + "ftp://example.org/foo-1.tar.gz") + ("ftp://example.org/foo-1.tar.xz.sig" + "ftp://example.org/foo-1.tar.gz.sig"))) - (coalesce-sources (list (upstream-source - (package "foo") (version "1") - (urls '("ftp://example.org/foo-1.tar.gz")) - (signature-urls - '("ftp://example.org/foo-1.tar.gz.sig"))) - (upstream-source - (package "foo") (version "1") - (urls '("ftp://example.org/foo-1.tar.xz")) - (signature-urls - '("ftp://example.org/foo-1.tar.xz.sig")))))) + (map (lambda (source) + `(source ,(upstream-source-package source) + ,(upstream-source-version source) + ,(upstream-source-urls source) + ,(upstream-source-signature-urls source))) + (coalesce-sources (list (upstream-source + (package "foo") (version "1") + (urls '("ftp://example.org/foo-1.tar.gz")) + (signature-urls + '("ftp://example.org/foo-1.tar.gz.sig"))) + (upstream-source + (package "foo") (version "1") + (urls '("ftp://example.org/foo-1.tar.xz")) + (signature-urls + '("ftp://example.org/foo-1.tar.xz.sig"))))))) (test-end) From patchwork Thu May 18 15:16:19 2023 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: 50114 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 DBFB427BBE9; Thu, 18 May 2023 16:18:15 +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=-3.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H2,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 4EA2417A88 for ; Thu, 18 May 2023 16:18:15 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pzfOG-0004eT-Ep; Thu, 18 May 2023 11:18:04 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pzfOE-0004b5-4G for guix-patches@gnu.org; Thu, 18 May 2023 11:18:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1pzfOD-00029r-SW for guix-patches@gnu.org; Thu, 18 May 2023 11:18:01 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pzfOD-0005XJ-OO for guix-patches@gnu.org; Thu, 18 May 2023 11:18:01 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#63571] [PATCH 11/14] import: cpan: Remove unary 'string-append' call. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 18 May 2023 15:18:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 63571 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 63571@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 63571-submit@debbugs.gnu.org id=B63571.168442302721150 (code B ref 63571); Thu, 18 May 2023 15:18:01 +0000 Received: (at 63571) by debbugs.gnu.org; 18 May 2023 15:17:07 +0000 Received: from localhost ([127.0.0.1]:54156 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pzfNL-0005V3-EF for submit@debbugs.gnu.org; Thu, 18 May 2023 11:17:07 -0400 Received: from eggs.gnu.org ([209.51.188.92]:55680) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pzfN1-0005Qe-Lm for 63571@debbugs.gnu.org; Thu, 18 May 2023 11:16:48 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pzfMw-0001w5-Fw; Thu, 18 May 2023 11:16:42 -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=2hxGdaAKbuwbDaEtf1LLiwzQpIAviJMAYlbDm445Kes=; b=cZ1bVYisj+RNETtptOlk knMvVMzXqiHUuBy7+VQrbWJCEy01Tjk2Cv2DuGrzBj6cFf6HM+8waL4Mu3IxoQYla5tpZvUlJLdxW yo+wti4ZlAlcQc2irk1OFUZ1wjEuEdla7yCpMZCJ+UqukfGsaPE7ii7Ud0qG/L0ISry1a2KlfzcVL bk0cCKJA+BsEk4X8oM6+y7rG/JZnEWpLPoZaiKfpj5kxhuCBYOjPNEnrZqo4NTKCv4SCbfFMSv4P6 OD/0to/miWwP5sAU4qSUy/41lQLDvwGGNY3R2TQK2uiN5A9Wa4FyI5dY+IXeYLwZI80arOlTMLzqu 9v2krSQ99Fcnbg==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201] helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pzfMw-0007G6-35; Thu, 18 May 2023 11:16:42 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Thu, 18 May 2023 17:16:19 +0200 Message-Id: X-Mailer: git-send-email 2.40.1 In-Reply-To: References: 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-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches * guix/import/cpan.scm (package->upstream-name): Remove useless 'string-append'. --- guix/import/cpan.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/guix/import/cpan.scm b/guix/import/cpan.scm index da47018c35..d7f300777e 100644 --- a/guix/import/cpan.scm +++ b/guix/import/cpan.scm @@ -154,7 +154,7 @@ (define (package->upstream-name package) ((? origin? origin) (match (origin-uri origin) ((or (? string? url) (url _ ...)) - (match (string-match (string-append "([^/]*)-v?[0-9\\.]+") url) + (match (string-match "([^/]*)-v?[0-9\\.]+" url) (#f #f) (m (match:substring m 1)))) (_ #f))) From patchwork Thu May 18 15:16:20 2023 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: 50119 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 0C78A27BBE2; Thu, 18 May 2023 16:18:29 +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=-3.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H2,SPF_HELO_PASS, URIBL_BLOCKED autolearn=ham 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 9B1DD17A72 for ; Thu, 18 May 2023 16:18:27 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pzfON-0004j9-Iw; Thu, 18 May 2023 11:18:11 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pzfOG-0004ew-Kj for guix-patches@gnu.org; Thu, 18 May 2023 11:18:04 -0400 Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1pzfOG-0002AM-C4 for guix-patches@gnu.org; Thu, 18 May 2023 11:18:04 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pzfOG-0005Y0-5x for guix-patches@gnu.org; Thu, 18 May 2023 11:18:04 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#63571] [PATCH 12/14] import: cpan: Represent dependencies as records. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 18 May 2023 15:18:04 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 63571 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 63571@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 63571-submit@debbugs.gnu.org id=B63571.168442303121187 (code B ref 63571); Thu, 18 May 2023 15:18:04 +0000 Received: (at 63571) by debbugs.gnu.org; 18 May 2023 15:17:11 +0000 Received: from localhost ([127.0.0.1]:54168 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pzfNP-0005Va-1y for submit@debbugs.gnu.org; Thu, 18 May 2023 11:17:11 -0400 Received: from eggs.gnu.org ([209.51.188.92]:55696) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pzfN2-0005Qt-G7 for 63571@debbugs.gnu.org; Thu, 18 May 2023 11:16:52 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pzfMx-0001wH-9y; Thu, 18 May 2023 11:16:43 -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=qFFHT6l8XAKZCoiV9Q/KxA8PSqy/ofNEYETzd9HlyYM=; b=lyzYf7b6P3/vJxYnWGwU wv2FAAp6G90m3Gc2wfqmaW9cjMgprDfz18GnfbIZhbwuYomx6CgA7Ucs1QceIrpsZjqmCWBIAOcVh facZUlzLut5GbVJN3hQZTzwFPCq/NrVdVvqO9EgUdQrHsxoQCv5VcD9KaVDVAB+wdIV7j1yb/5F38 rz8zKGEpTwJyyVhJAqNYc7li6ZJxFx4pzpT3xsOazZAWOcO9PVcHAc0NKJCfdgbNNUfU/6G4VJT1X ZMtWhmOMMwwFFuaEuSvt/RqW0NBApVeYR87rY5QgKl1M5dF3g36dfw9cbFII6ZjNhmD/Un4bPo/tN hqbTMcp3sKd0Mg==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201] helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pzfMw-0007G6-TS; Thu, 18 May 2023 11:16:43 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Thu, 18 May 2023 17:16:20 +0200 Message-Id: X-Mailer: git-send-email 2.40.1 In-Reply-To: References: 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-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches * guix/import/cpan.scm (cpan-name->downstream-name) (cran-dependency->upstream-input, cran-module-inputs): New procedures. (cpan-module->sexp)[guix-name, convert-inputs]: Remove. [maybe-inputs]: Adjust to deal with . Use 'cpan-name->downstream-name' instead of 'guix-name'. Add call to 'cpan-module-inputs' and adjust calls to 'maybe-inputs'. No longer emit input labels. * tests/cpan.scm ("cpan->guix-package"): Adjust test accordingly. --- guix/import/cpan.scm | 98 +++++++++++++++++++++++++------------------- tests/cpan.scm | 7 +--- 2 files changed, 58 insertions(+), 47 deletions(-) diff --git a/guix/import/cpan.scm b/guix/import/cpan.scm index d7f300777e..b6587d6821 100644 --- a/guix/import/cpan.scm +++ b/guix/import/cpan.scm @@ -3,7 +3,7 @@ ;;; Copyright © 2015 Mark H Weaver ;;; Copyright © 2016 Alex Sassmannshausen ;;; Copyright © 2017, 2018 Tobias Geerinckx-Rice -;;; Copyright © 2020, 2021 Ludovic Courtès +;;; Copyright © 2020, 2021, 2023 Ludovic Courtès ;;; Copyright © 2022 Hartmut Goebel ;;; ;;; This file is part of GNU Guix. @@ -222,56 +222,73 @@ (define core-module? first perl-version last)))) (loop))))))))))) +(define (cpan-name->downstream-name name) + "Return the Guix package name corresponding to NAME." + (if (string-prefix? "perl-" name) + (string-downcase name) + (string-append "perl-" (string-downcase name)))) + +(define (cran-dependency->upstream-input dependency) + "Return the corresponding to DEPENDENCY, or #f if +DEPENDENCY denotes an implicit or otherwise unnecessary dependency." + (match (cpan-dependency-module dependency) + ("perl" #f) ;implicit dependency + (module + (let ((type (match (cpan-dependency-phase dependency) + ((or 'configure 'build 'test) + ;; "runtime" may also be needed here. See + ;; https://metacpan.org/pod/CPAN::Meta::Spec#Phases, + ;; which says they are required during + ;; building. We have not yet had a need for + ;; cross-compiled Perl modules, however, so + ;; we leave it out. + 'native) + ('runtime + 'propagated) + (_ + #f)))) + (and type + (not (core-module? module)) ;expensive call! + (upstream-input + (name (module->dist-name module)) + (downstream-name (cpan-name->downstream-name name)) + (type type))))))) + +(define (cpan-module-inputs release) + "Return the list of for dependencies of RELEASE, a +." + (define (upstream-inputupstream-input + (cpan-release-dependencies release))) + upstream-inputsexp release) "Return the 'package' s-expression for a CPAN module from the release data in RELEASE, a record." (define name (cpan-release-distribution release)) - (define (guix-name name) - (if (string-prefix? "perl-" name) - (string-downcase name) - (string-append "perl-" (string-downcase name)))) - (define version (cpan-release-version release)) (define source-url (cpan-source-url release)) - (define (convert-inputs phases) - ;; Convert phase dependencies into a list of name/variable pairs. - (match (filter-map (lambda (dependency) - (and (memq (cpan-dependency-phase dependency) - phases) - (cpan-dependency-module dependency))) - (cpan-release-dependencies release)) - ((inputs ...) - (sort - (delete-duplicates - ;; Listed dependencies may include core modules. Filter those out. - (filter-map (match-lambda - ("perl" #f) ;implicit dependency - ((? core-module?) #f) - (module - (let ((name (guix-name (module->dist-name module)))) - (list name - (list 'unquote (string->symbol name)))))) - inputs)) - (lambda args - (match args - (((a _ ...) (b _ ...)) - (stringsymbol + upstream-input-downstream-name) + inputs))))))) (let ((tarball (with-store store - (download-to-store store source-url)))) + (download-to-store store source-url))) + (inputs (cpan-module-inputs release))) `(package - (name ,(guix-name name)) + (name ,(cpan-name->downstream-name name)) (version ,version) (source (origin (method url-fetch) @@ -281,14 +298,11 @@ (define (cpan-module->sexp release) ,(bytevector->nix-base32-string (file-sha256 tarball)))))) (build-system perl-build-system) ,@(maybe-inputs 'native-inputs - ;; "runtime" may also be needed here. See - ;; https://metacpan.org/pod/CPAN::Meta::Spec#Phases, - ;; which says they are required during building. We - ;; have not yet had a need for cross-compiled perl - ;; modules, however, so we leave it out. - (convert-inputs '(configure build test))) + (filter (upstream-input-type-predicate 'native) + inputs)) ,@(maybe-inputs 'propagated-inputs - (convert-inputs '(runtime))) + (filter (upstream-input-type-predicate 'propagated) + inputs)) (home-page ,(cpan-home name)) (synopsis ,(cpan-release-abstract release)) (description fill-in-yourself!) diff --git a/tests/cpan.scm b/tests/cpan.scm index bbcd108e12..c9dd6d36de 100644 --- a/tests/cpan.scm +++ b/tests/cpan.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 Eric Bavier ;;; Copyright © 2016 Alex Sassmannshausen -;;; Copyright © 2020 Ludovic Courtès +;;; Copyright © 2020, 2023 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -64,7 +64,6 @@ (define test-source (test-begin "cpan") (test-assert "cpan->guix-package" - ;; Replace network resources with sample data. (with-http-server `((200 ,test-json) (200 ,test-source) (200 "{ \"distribution\" : \"Test-Script\" }")) @@ -82,9 +81,7 @@ (define test-source ('base32 (? string? hash))))) ('build-system 'perl-build-system) - ('propagated-inputs - ('quasiquote - (("perl-test-script" ('unquote 'perl-test-script))))) + ('propagated-inputs ('list 'perl-test-script)) ('home-page "https://metacpan.org/release/Foo-Bar") ('synopsis "Fizzle Fuzz") ('description 'fill-in-yourself!) From patchwork Thu May 18 15:16:21 2023 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: 50116 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 5A9B627BBE2; Thu, 18 May 2023 16:18:20 +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=-3.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H2,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 9C59717A72 for ; Thu, 18 May 2023 16:18:18 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pzfOG-0004f0-OP; Thu, 18 May 2023 11:18:04 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pzfOF-0004d6-9H for guix-patches@gnu.org; Thu, 18 May 2023 11:18:03 -0400 Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1pzfOF-0002A6-0p for guix-patches@gnu.org; Thu, 18 May 2023 11:18:03 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pzfOE-0005Xa-Ry for guix-patches@gnu.org; Thu, 18 May 2023 11:18:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#63571] [PATCH 13/14] import: cpan: Updater provides input list. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 18 May 2023 15:18:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 63571 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 63571@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 63571-submit@debbugs.gnu.org id=B63571.168442303021173 (code B ref 63571); Thu, 18 May 2023 15:18:02 +0000 Received: (at 63571) by debbugs.gnu.org; 18 May 2023 15:17:10 +0000 Received: from localhost ([127.0.0.1]:54164 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pzfNO-0005VL-0k for submit@debbugs.gnu.org; Thu, 18 May 2023 11:17:10 -0400 Received: from eggs.gnu.org ([209.51.188.92]:55698) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pzfN3-0005R0-Ac for 63571@debbugs.gnu.org; Thu, 18 May 2023 11:16:49 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pzfMy-0001wR-4F; Thu, 18 May 2023 11:16:44 -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=AJIRNvPuRGp7n+ouE86Sv0Ifra7WWFR8mKH0dXxOYa8=; b=nPwTIr08CLcaonJ136+j Y/6kwMDfPJM2a/y4B4xOK4gS7djesF7yvmulF6imv8OHj3uhqKmKUilsnxPbzdoLGAo7UpQPYG0lU Vj5NDom+Ym/sd7+7ydoW3YSTqXAkTTMz5+o7dSxrb9bfh2GL4u+31wtzXWqLBulmgrTJKnt8KS4A7 lkUOC2N6dypO15XHPCq3bf7Q0Xauvcjr6/eJ6Kjdt0OBhqdsTbGdmi29UzOyD7b3TVKZGWROx6zl+ Xee8H14/Ly0FK5crnmgjnGKkF9Sce1kCtv2ab//Z7vYPkxMdigGwuVWWfkEjDzFP11b5miTsJ13PW 0q6Gu7sgTl2b3A==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201] helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pzfMx-0007G6-Nr; Thu, 18 May 2023 11:16:43 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Thu, 18 May 2023 17:16:21 +0200 Message-Id: X-Mailer: git-send-email 2.40.1 In-Reply-To: References: 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-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches * guix/import/cpan.scm (latest-release): Add 'inputs' field. * tests/cpan.scm ("package-latest-release"): New test. --- guix/import/cpan.scm | 3 ++- tests/cpan.scm | 27 +++++++++++++++++++++++++++ 2 files changed, 29 insertions(+), 1 deletion(-) diff --git a/guix/import/cpan.scm b/guix/import/cpan.scm index b6587d6821..b87736eef6 100644 --- a/guix/import/cpan.scm +++ b/guix/import/cpan.scm @@ -354,7 +354,8 @@ (define* (latest-release package #:key (version #f)) (upstream-source (package (package-name package)) (version version) - (urls (list url))))))) + (urls (list url)) + (inputs (cpan-module-inputs release))))))) (define %cpan-updater (upstream-updater diff --git a/tests/cpan.scm b/tests/cpan.scm index c9dd6d36de..5fcce85d8d 100644 --- a/tests/cpan.scm +++ b/tests/cpan.scm @@ -21,7 +21,10 @@ (define-module (test-cpan) #:use-module (guix import cpan) #:use-module (guix base32) + #:use-module (guix upstream) + #:use-module ((guix download) #:select (url-fetch)) #:use-module (gcrypt hash) + #:use-module (guix tests) #:use-module (guix tests http) #:use-module ((guix store) #:select (%graft?)) #:use-module (srfi srfi-64) @@ -92,6 +95,30 @@ (define test-source (x (pk 'fail x #f)))))) +(test-equal "package-latest-release" + (list '("http://example.com/Foo-Bar-0.1.tar.gz") + #f + (list (upstream-input + (name "Test-Script") + (downstream-name "perl-test-script") + (type 'propagated)))) + (with-http-server `((200 ,test-json) + (200 ,test-source) + (200 "{ \"distribution\" : \"Test-Script\" }")) + (define source + (parameterize ((%metacpan-base-url (%local-url))) + (package-latest-release + (dummy-package "perl-test-script" + (version "0.0.0") + (source (dummy-origin + (method url-fetch) + (uri "mirror://cpan/Foo-Bar-0.0.0.tgz")))) + (list %cpan-updater)))) + + (list (upstream-source-urls source) + (upstream-source-signature-urls source) + (upstream-source-inputs source)))) + (test-equal "metacpan-url->mirror-url, http" "mirror://cpan/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz" (metacpan-url->mirror-url From patchwork Thu May 18 15:16:22 2023 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: 50120 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 9440A27BBE2; Thu, 18 May 2023 16:18:31 +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=-3.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H2,SPF_HELO_PASS, URIBL_BLOCKED autolearn=ham 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 5024817A72 for ; Thu, 18 May 2023 16:18:30 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pzfOM-0004gt-Fs; Thu, 18 May 2023 11:18:11 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pzfOG-0004dq-2R for guix-patches@gnu.org; Thu, 18 May 2023 11:18:04 -0400 Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1pzfOF-0002AG-Ql for guix-patches@gnu.org; Thu, 18 May 2023 11:18:03 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pzfOF-0005Xj-HG; Thu, 18 May 2023 11:18:03 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#63571] [PATCH 14/14] import: elpa: Updater provides input list. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: andrew@trop.in, liliana.prikler@gmail.com, guix-patches@gnu.org Resent-Date: Thu, 18 May 2023 15:18:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 63571 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 63571@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= , Andrew Tropin , Liliana Marie Prikler X-Debbugs-Original-Xcc: Andrew Tropin , Liliana Marie Prikler Received: via spool by 63571-submit@debbugs.gnu.org id=B63571.168442303121181 (code B ref 63571); Thu, 18 May 2023 15:18:03 +0000 Received: (at 63571) by debbugs.gnu.org; 18 May 2023 15:17:11 +0000 Received: from localhost ([127.0.0.1]:54166 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pzfNO-0005VS-E9 for submit@debbugs.gnu.org; Thu, 18 May 2023 11:17:11 -0400 Received: from eggs.gnu.org ([209.51.188.92]:55700) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pzfN4-0005R8-57 for 63571@debbugs.gnu.org; Thu, 18 May 2023 11:16:50 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pzfMy-0001wc-Uu; Thu, 18 May 2023 11:16:44 -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=wx3ddpSm5Fi/Xrhs3szemuX9sJgYB3xIR1/5VvIxJMM=; b=Gl0/oWWdNscIOaFuYD4S wPuyvWjutAW5q6RjkWZ96IwR2R+mwttOjykIaEiqRMIEPCfZmfmn56l9eOgypSwjQAu8fynqljQDA WIKyURmGaESwSgIl1T8j9+cmPVCaP+XoaDyRh2rJ2LBofPc/kieEquaDYzGdp5thfvUbSjjUkp3OT 8uQNIlwsd5dVbvSFCQawPAQb6HiuuyuS5ZU4dVEi4+DlIUWstmMGqkMJFP7e/ODbsdmuLVY6/iwk7 VApvoXmWHaOH3jV1Lxf855+/IrYY6ui8jNBD94iYeTXvmv1vYIzZ5PBg1He6nztuBJXmRUwBmiUGg l9TYFyd0yU8ZPg==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201] helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pzfMy-0007G6-IS; Thu, 18 May 2023 11:16:44 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Thu, 18 May 2023 17:16:22 +0200 Message-Id: X-Mailer: git-send-email 2.40.1 In-Reply-To: References: 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-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches * guix/import/elpa.scm (elpa-dependency->upstream-input): New procedure. (latest-release): Add 'inputs' field. * tests/elpa.scm ("package-latest-release"): New test. --- guix/import/elpa.scm | 28 ++++++++++++++++++++++++-- tests/elpa.scm | 48 ++++++++++++++++++++++++++++++++++++++++++-- 2 files changed, 72 insertions(+), 4 deletions(-) diff --git a/guix/import/elpa.scm b/guix/import/elpa.scm index 1313a8aa67..f32a3a156e 100644 --- a/guix/import/elpa.scm +++ b/guix/import/elpa.scm @@ -272,6 +272,25 @@ (define* (melpa-recipe->origin recipe) (assq-ref recipe ':fetcher)) #f))) +(define (elpa-dependency->upstream-input dependency) + "Convert DEPENDENCY, an sexp as returned by 'elpa-package-inputs', into an +." + (match dependency + ((name version) + (and (not (emacs-standard-library? (symbol->string name))) + (upstream-input + (name (symbol->string name)) + (downstream-name (elpa-guix-name name)) + (type 'propagated) + (min-version (if (pair? version) + (string-join (map number->string version) ".") + #f)) + (max-version (match version + (() #f) + ((_) #f) + ((_ _) #f) + (_ min-version)))))))) + (define default-files-spec ;; This contains more than just the things contained in %default-include and ;; %default-exclude, presumably because this includes source files (*.in, @@ -421,12 +440,17 @@ (define* (latest-release package #:key (version #f)) (elpa-version->string raw-version)))) (url (match info ((_ raw-version reqs synopsis kind . rest) - (package-source-url kind name version repo))))) + (package-source-url kind name version repo)))) + (inputs (match info + ((name raw-version reqs . _) + (filter-map elpa-dependency->upstream-input + reqs))))) (upstream-source (package (package-name package)) (version version) (urls (list url)) - (signature-urls (list (string-append url ".sig")))))))) + (signature-urls (list (string-append url ".sig"))) + (inputs inputs)))))) (define elpa-repository (memoize diff --git a/tests/elpa.scm b/tests/elpa.scm index 1efdf2457f..56008fe014 100644 --- a/tests/elpa.scm +++ b/tests/elpa.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 Federico Beffa -;;; Copyright © 2020 Ludovic Courtès +;;; Copyright © 2020, 2023 Ludovic Courtès ;;; Copyright © 2020 Martin Becze ;;; Copyright © 2021 Xinglu Chen ;;; @@ -21,6 +21,8 @@ (define-module (test-elpa) #:use-module (guix import elpa) + #:use-module (guix upstream) + #:use-module ((guix download) #:select (url-fetch)) #:use-module (guix tests) #:use-module (guix tests http) #:use-module (srfi srfi-1) @@ -40,8 +42,20 @@ (define elpa-mock-archive (auctex . [(11 88 6) nil "Integrated environment for *TeX*" tar - ((:url . "http://www.gnu.org/software/auctex/"))]))) + ((:url . "http://www.gnu.org/software/auctex/"))]) + (taxy-magit-section . + [(0 12 2) + ((emacs + (26 3)) + (magit-section + (3 2 1)) + (taxy + (0 10))) + "View Taxy structs in a Magit Section buffer" tar + ((:url . "https://github.com/alphapapa/taxy.el") + (:keywords "lisp"))]))) + (test-begin "elpa") (define (eval-test-with-elpa pkg) @@ -73,6 +87,36 @@ (define (eval-test-with-elpa pkg) (test-assert "elpa->guix-package test 1" (eval-test-with-elpa "auctex")) +(test-equal "package-latest-release" + (list '("https://elpa.gnu.org/packages/taxy-magit-section-0.12.2.tar") + '("https://elpa.gnu.org/packages/taxy-magit-section-0.12.2.tar.sig") + (list (upstream-input + (name "magit-section") + (downstream-name "emacs-magit-section") + (type 'propagated) + (min-version "3.2.1") + (max-version min-version)) + (upstream-input + (name "taxy") + (downstream-name "emacs-taxy") + (type 'propagated) + (min-version "0.10") + (max-version #f)))) + (with-http-server `((200 ,(object->string elpa-mock-archive))) + (parameterize ((current-http-proxy (%local-url))) + (define source + (package-latest-release + (dummy-package "emacs-taxy-magit-section" + (version "0.0.0") + (source (dummy-origin + (method url-fetch) + (uri "https://elpa.gnu.org/xyz")))) + (list %elpa-updater))) + + (list (upstream-source-urls source) + (upstream-source-signature-urls source) + (upstream-source-inputs source))))) + (test-equal "guix-package->elpa-name: without 'upstream-name' property" "auctex" (guix-package->elpa-name (dummy-package "emacs-auctex")))