* [bug#63571] [PATCH v2 01/19] tests: pypi: Factorize tarball and wheel file creation.
2023-05-29 14:44 ` Ludovic Courtès
@ 2023-05-29 14:45 ` Ludovic Courtès
2023-05-29 14:45 ` [bug#63571] [PATCH v2 02/19] tests: http: Allow responses to specify a path Ludovic Courtès
` (18 subsequent siblings)
19 siblings, 0 replies; 38+ messages in thread
From: Ludovic Courtès @ 2023-05-29 14:45 UTC (permalink / raw)
To: 63571; +Cc: Ludovic Courtès, Lars-Dominik Braun, jgart
* 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))
+
\f
(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)
base-commit: fb1c5d4df7d1479e715f9a28246ef8f92513be59
--
2.40.1
^ permalink raw reply related [flat|nested] 38+ messages in thread* [bug#63571] [PATCH v2 02/19] tests: http: Allow responses to specify a path.
2023-05-29 14:44 ` Ludovic Courtès
2023-05-29 14:45 ` [bug#63571] [PATCH v2 01/19] tests: pypi: Factorize tarball and wheel file creation Ludovic Courtès
@ 2023-05-29 14:45 ` Ludovic Courtès
2023-05-29 14:45 ` [bug#63571] [PATCH v2 03/19] tests: pypi: Rewrite tests using a local HTTP server Ludovic Courtès
` (17 subsequent siblings)
19 siblings, 0 replies; 38+ messages in thread
From: Ludovic Courtès @ 2023-05-29 14:45 UTC (permalink / raw)
To: 63571; +Cc: Ludovic Courtès
* 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 <ludo@gnu.org>
+;;; Copyright © 2014-2017, 2019, 2023 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;;
;;; 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)))))
--
2.40.1
^ permalink raw reply related [flat|nested] 38+ messages in thread* [bug#63571] [PATCH v2 03/19] tests: pypi: Rewrite tests using a local HTTP server.
2023-05-29 14:44 ` Ludovic Courtès
2023-05-29 14:45 ` [bug#63571] [PATCH v2 01/19] tests: pypi: Factorize tarball and wheel file creation Ludovic Courtès
2023-05-29 14:45 ` [bug#63571] [PATCH v2 02/19] tests: http: Allow responses to specify a path Ludovic Courtès
@ 2023-05-29 14:45 ` Ludovic Courtès
2023-05-29 14:45 ` [bug#63571] [PATCH v2 04/19] import: utils: 'call-with-networking-exception-handler' doesn't unwind Ludovic Courtès
` (16 subsequent siblings)
19 siblings, 0 replies; 38+ messages in thread
From: Ludovic Courtès @ 2023-05-29 14:45 UTC (permalink / raw)
To: 63571; +Cc: Ludovic Courtès, Lars-Dominik Braun, jgart
* 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:
;; <https://warehouse.readthedocs.io/api-reference/json/>.
+(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 <distribution> make-distribution distribution?
(define (pypi-fetch name)
"Return a <pypi-project> 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 ...)))
+
\f
(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:
--
2.40.1
^ permalink raw reply related [flat|nested] 38+ messages in thread* [bug#63571] [PATCH v2 04/19] import: utils: 'call-with-networking-exception-handler' doesn't unwind.
2023-05-29 14:44 ` Ludovic Courtès
` (2 preceding siblings ...)
2023-05-29 14:45 ` [bug#63571] [PATCH v2 03/19] tests: pypi: Rewrite tests using a local HTTP server Ludovic Courtès
@ 2023-05-29 14:45 ` Ludovic Courtès
2023-05-29 14:45 ` [bug#63571] [PATCH v2 05/19] import: json: Add #:timeout to 'json-fetch' Ludovic Courtès
` (15 subsequent siblings)
19 siblings, 0 replies; 38+ messages in thread
From: Ludovic Courtès @ 2023-05-29 14:45 UTC (permalink / raw)
To: 63571; +Cc: Ludovic Courtès
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."
--
2.40.1
^ permalink raw reply related [flat|nested] 38+ messages in thread* [bug#63571] [PATCH v2 05/19] import: json: Add #:timeout to 'json-fetch'.
2023-05-29 14:44 ` Ludovic Courtès
` (3 preceding siblings ...)
2023-05-29 14:45 ` [bug#63571] [PATCH v2 04/19] import: utils: 'call-with-networking-exception-handler' doesn't unwind Ludovic Courtès
@ 2023-05-29 14:45 ` Ludovic Courtès
2023-05-29 14:45 ` [bug#63571] [PATCH v2 06/19] doc: Mention 'guix refresh -u' for third-party channels Ludovic Courtès
` (14 subsequent siblings)
19 siblings, 0 replies; 38+ messages in thread
From: Ludovic Courtès @ 2023-05-29 14:45 UTC (permalink / raw)
To: 63571; +Cc: Ludovic Courtès
* 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 <davet@gnu.org>
;;; Copyright © 2015, 2016 Eric Bavier <bavier@member.fsf.org>
-;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018, 2019, 2023 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; 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)))
--
2.40.1
^ permalink raw reply related [flat|nested] 38+ messages in thread* [bug#63571] [PATCH v2 06/19] doc: Mention 'guix refresh -u' for third-party channels.
2023-05-29 14:44 ` Ludovic Courtès
` (4 preceding siblings ...)
2023-05-29 14:45 ` [bug#63571] [PATCH v2 05/19] import: json: Add #:timeout to 'json-fetch' Ludovic Courtès
@ 2023-05-29 14:45 ` Ludovic Courtès
2023-05-29 14:45 ` [bug#63571] [PATCH v2 07/19] upstream: Replace 'input-changes' field by 'inputs' Ludovic Courtès
` (13 subsequent siblings)
19 siblings, 0 replies; 38+ messages in thread
From: Ludovic Courtès @ 2023-05-29 14:45 UTC (permalink / raw)
To: 63571; +Cc: Ludovic Courtès
* doc/guix.texi (Invoking guix refresh): Show how to run 'guix refresh
-u' on a third-party channel.
---
doc/guix.texi | 11 +++++++++--
1 file changed, 9 insertions(+), 2 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 31dc33fb97..b52a40cc38 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -14340,15 +14340,22 @@ Invoking guix refresh
@item --update
@itemx -u
-Update distribution source files (package recipes) in place. This is
+Update distribution source files (package definitions) in place. This is
usually run from a checkout of the Guix source tree (@pxref{Running
Guix Before It Is Installed}):
@example
-$ ./pre-inst-env guix refresh -s non-core -u
+./pre-inst-env guix refresh -s non-core -u
@end example
@xref{Defining Packages}, for more information on package definitions.
+You can also run it on packages from a third-party channel:
+
+@example
+guix refresh -L /path/to/channel -u @var{package}
+@end example
+
+@xref{Creating a Channel}, on how to create a channel.
@item --select=[@var{subset}]
@itemx -s @var{subset}
--
2.40.1
^ permalink raw reply related [flat|nested] 38+ messages in thread* [bug#63571] [PATCH v2 07/19] upstream: Replace 'input-changes' field by 'inputs'.
2023-05-29 14:44 ` Ludovic Courtès
` (5 preceding siblings ...)
2023-05-29 14:45 ` [bug#63571] [PATCH v2 06/19] doc: Mention 'guix refresh -u' for third-party channels Ludovic Courtès
@ 2023-05-29 14:45 ` Ludovic Courtès
2023-05-29 14:45 ` [bug#63571] [PATCH v2 08/19] diagnostics: Factorize 'absolute-location' Ludovic Courtès
` (12 subsequent siblings)
19 siblings, 0 replies; 38+ messages in thread
From: Ludovic Courtès @ 2023-05-29 14:45 UTC (permalink / raw)
To: 63571
Cc: Ludovic Courtès, Christopher Baines, Josselin Poiret,
Lars-Dominik Braun, Ludovic Courtès, Mathieu Othacehe,
Ricardo Wurmus, Simon Tournier, Tobias Geerinckx-Rice, jgart
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 (<upstream-source>)[input-changes]: Remove.
[inputs]: New field.
(<upstream-input>): 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 <upstream-source> as its second argument.
Adjust accordingly.
* guix/import/pypi.scm (distribution-sha256): New procedure.
(maybe-inputs): Expect a list of <upstream-input>.
(compute-inputs): Rewrite to return a list of <upstream-input>.
(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 <upstream-source>.
(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 <upstream-input>.
(source-dir->dependencies): Return a list of <upstream-input>.
(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.
(format-inputs): Remove.
* guix/import/hackage.scm (cabal-package-inputs): New procedure.
(hackage-module->sexp): Use it.
[maybe-inputs]: Expect a list of <upstream-input>.
---
guix/import/cran.scm | 194 +++++++++++++++++++++++-------------
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/pypi.scm | 62 ++++++++++--
tests/upstream.scm | 140 ++++++++++----------------
8 files changed, 511 insertions(+), 358 deletions(-)
diff --git a/guix/import/cran.scm b/guix/import/cran.scm
index bb271634ed..d25f334396 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 <rekado@elephly.net>
-;;; Copyright © 2015, 2016, 2017, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015-2017, 2019-2021, 2023 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
@@ -164,24 +164,16 @@ (define (description->alist description)
rest)))))))
(fold parse '() lines)))
-(define (format-inputs names)
- "Generate a sorted list of package inputs from a list of package NAMES."
- (map (lambda (name)
- (case (%input-style)
- ((specification)
- `(specification->package ,name))
- (else
- (string->symbol name))))
- (sort names string-ci<?)))
-
-(define* (maybe-inputs package-inputs #:optional (type 'inputs))
+(define* (maybe-inputs package-inputs #:optional (input-type 'inputs))
"Given a list of PACKAGE-INPUTS, tries to generate the TYPE field of a
package definition."
(match package-inputs
(()
'())
((package-inputs ...)
- `((,type (list ,@(format-inputs package-inputs)))))))
+ `((,input-type (list ,@(map (compose string->symbol
+ 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 +512,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
+<upstream-input> 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 +548,79 @@ (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 <upstream-input> 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 <upstream-input> 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)))))
+ (sort (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))
+ (lambda (input1 input2)
+ (string<? (upstream-input-downstream-name input1)
+ (upstream-input-downstream-name input2))))))
(define* (description->package repository meta #:key (license-prefix identity)
(download-source download))
@@ -556,11 +635,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 +646,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 +701,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 +731,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 +819,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 <upstream-source> for the latest release of the package PKG."
@@ -784,10 +841,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 <iskarian@mgsn.dev>
;;; Copyright © 2019 Simon Tournier <zimon.toutoune@gmail.com>
;;; Copyright © 2022 Hartmut Goebel <h.goebel@crazy-compilers.com>
+;;; Copyright © 2023 Ludovic Courtès <ludo@gnu.org>
;;;
;;; 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 <upstream-input> 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 <davet@gnu.org>
;;; Copyright © 2015 Cyril Roelandt <tipecaml@gmail.com>
-;;; Copyright © 2015-2017, 2019-2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015-2017, 2019-2023 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2018, 2023 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com>
@@ -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 <distribution> 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 <pypi-project> 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-ci<?)))
-
- (define process-requirements
- (compose requirement->package-name/sort strip-argparse))
-
+the corresponding list of <upstream-input> 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<?)))
+
+ ;; TODO: Record version number ranges in <upstream-input>.
(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 <upstream-input> 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
+<pypi-project> 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
+<pypi-project> 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 bfa6269aa3..d838a4aca2 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 <ludo@gnu.org>
+;;; Copyright © 2013-2023 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2015 Alex Kost <alezost@gmail.com>
@@ -404,7 +404,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 aac501c466..52f9333878 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 <ludo@gnu.org>
+;;; Copyright © 2010-2023 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Alex Kost <alezost@gmail.com>
;;; Copyright © 2019, 2022 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
@@ -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* <upstream-source>
(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 <upstream-input>
+ (delayed) (default #f))) ;delayed because optional and costly
+
+;; Representation of a dependency as expressed by upstream.
+(define-record-type* <upstream-input>
+ 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 <upstream-input> 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 <upstream-source>, 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* <upstream-input-change>
@@ -113,67 +158,55 @@ (define-record-type* <upstream-input-change>
(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 <upstream-source> 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/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 <ludo@gnu.org>
+;;; Copyright © 2016, 2023 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2022 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; 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)
--
2.40.1
^ permalink raw reply related [flat|nested] 38+ messages in thread* [bug#63571] [PATCH v2 08/19] diagnostics: Factorize 'absolute-location'.
2023-05-29 14:44 ` Ludovic Courtès
` (6 preceding siblings ...)
2023-05-29 14:45 ` [bug#63571] [PATCH v2 07/19] upstream: Replace 'input-changes' field by 'inputs' Ludovic Courtès
@ 2023-05-29 14:45 ` Ludovic Courtès
2023-05-29 14:45 ` [bug#63571] [PATCH v2 09/19] upstream: 'update-package-source' edits input fields Ludovic Courtès
` (11 subsequent siblings)
19 siblings, 0 replies; 38+ messages in thread
From: Ludovic Courtès @ 2023-05-29 14:45 UTC (permalink / raw)
To: 63571
Cc: Ludovic Courtès, Christopher Baines, Josselin Poiret,
Ludovic Courtès, Mathieu Othacehe, Ricardo Wurmus,
Simon Tournier, Tobias Geerinckx-Rice
* 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 <ludo@gnu.org>
+;;; Copyright © 2012-2021, 2023 Ludovic Courtès <ludo@gnu.org>
;;;
;;; 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)))
+
\f
(define guix-warning-port
(make-parameter (current-warning-port)))
diff --git a/guix/scripts/style.scm b/guix/scripts/style.scm
index 1d02742524..4920a8d969 100644
--- a/guix/scripts/style.scm
+++ b/guix/scripts/style.scm
@@ -226,23 +226,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 52f9333878..4ae2d1c8c8 100644
--- a/guix/upstream.scm
+++ b/guix/upstream.scm
@@ -637,8 +637,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)
--
2.40.1
^ permalink raw reply related [flat|nested] 38+ messages in thread* [bug#63571] [PATCH v2 09/19] upstream: 'update-package-source' edits input fields.
2023-05-29 14:44 ` Ludovic Courtès
` (7 preceding siblings ...)
2023-05-29 14:45 ` [bug#63571] [PATCH v2 08/19] diagnostics: Factorize 'absolute-location' Ludovic Courtès
@ 2023-05-29 14:45 ` Ludovic Courtès
2023-05-29 14:45 ` [bug#63571] [PATCH v2 10/19] upstream: Remove <upstream-input-change> and related code Ludovic Courtès
` (10 subsequent siblings)
19 siblings, 0 replies; 38+ messages in thread
From: Ludovic Courtès @ 2023-05-29 14:45 UTC (permalink / raw)
To: 63571
Cc: Ludovic Courtès, Christopher Baines, Josselin Poiret,
Ludovic Courtès, Mathieu Othacehe, Ricardo Wurmus,
Simon Tournier, Tobias Geerinckx-Rice
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.
* doc/guix.texi (Invoking guix refresh): Mention it.
---
doc/guix.texi | 5 ++--
guix/import/test.scm | 13 +++++++++-
guix/scripts/refresh.scm | 36 --------------------------
guix/upstream.scm | 56 +++++++++++++++++++++++++++++++++++++---
tests/guix-refresh.sh | 7 +++--
5 files changed, 72 insertions(+), 45 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index b52a40cc38..c54a72bfaa 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -14308,8 +14308,9 @@ Invoking guix refresh
@end lisp
When passed @option{--update}, it modifies distribution source files to
-update the version numbers and source tarball hashes of those package
-recipes (@pxref{Defining Packages}). This is achieved by downloading
+update the version numbers and source code hashes of those package
+definitions, as well as possibly their inputs (@pxref{Defining Packages}).
+This is achieved by downloading
each package's latest source tarball and its associated OpenPGP
signature, authenticating the downloaded tarball against its signature
using @command{gpgv}, and finally computing its hash---note that GnuPG must be
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 d838a4aca2..9676271542 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -369,42 +369,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 4ae2d1c8c8..7d9ae70eda 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)
@@ -583,6 +584,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 <upstream-source>."
+ (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
<upstream-source> whose tarball has SHA256 HASH (a bytevector). Return the
@@ -637,9 +684,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))
@@ -648,8 +693,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"<<EOF
".tar.gz"))
(sha256
(base32
- "086vqwk2wl8zfs47sq2xpjc9k066ilmb8z6dn0q6ymwjzlm196cd"))))))
+ "086vqwk2wl8zfs47sq2xpjc9k066ilmb8z6dn0q6ymwjzlm196cd"))))
+ (inputs (list coreutils tar))))
EOF
guix refresh -t test -L "$module_dir" the-test-package
guix refresh -t test -L "$module_dir" the-test-package -u \
--keyring="$module_dir/keyring.kbx" # so we don't create $HOME/.config
grep 'version "5.5"' "$module_dir/sample.scm"
grep "$(guix hash -H sha256 -f nix-base32 "$module_dir/source")" "$module_dir/sample.scm"
+grep '(inputs (list grep sed))' "$module_dir/sample.scm"
# Specifying a target version.
guix refresh -t test guile=2.0.0 # XXX: should return non-zero?
--
2.40.1
^ permalink raw reply related [flat|nested] 38+ messages in thread* [bug#63571] [PATCH v2 10/19] upstream: Remove <upstream-input-change> and related code.
2023-05-29 14:44 ` Ludovic Courtès
` (8 preceding siblings ...)
2023-05-29 14:45 ` [bug#63571] [PATCH v2 09/19] upstream: 'update-package-source' edits input fields Ludovic Courtès
@ 2023-05-29 14:45 ` Ludovic Courtès
2023-05-29 14:45 ` [bug#63571] [PATCH v2 11/19] tests: upstream: Restore test that was skipped Ludovic Courtès
` (9 subsequent siblings)
19 siblings, 0 replies; 38+ messages in thread
From: Ludovic Courtès @ 2023-05-29 14:45 UTC (permalink / raw)
To: 63571
Cc: Ludovic Courtès, Christopher Baines, Josselin Poiret,
Ludovic Courtès, Mathieu Othacehe, Ricardo Wurmus,
Simon Tournier, Tobias Geerinckx-Rice
* guix/upstream.scm (<upstream-input-change>): 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 7d9ae70eda..53e473715c 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>
- 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 <upstream-source> 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 <origin> 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)
--
2.40.1
^ permalink raw reply related [flat|nested] 38+ messages in thread* [bug#63571] [PATCH v2 11/19] tests: upstream: Restore test that was skipped.
2023-05-29 14:44 ` Ludovic Courtès
` (9 preceding siblings ...)
2023-05-29 14:45 ` [bug#63571] [PATCH v2 10/19] upstream: Remove <upstream-input-change> and related code Ludovic Courtès
@ 2023-05-29 14:45 ` Ludovic Courtès
2023-05-29 14:45 ` [bug#63571] [PATCH v2 12/19] import: cpan: Remove unary 'string-append' call Ludovic Courtès
` (8 subsequent siblings)
19 siblings, 0 replies; 38+ messages in thread
From: Ludovic Courtès @ 2023-05-29 14:45 UTC (permalink / raw)
To: 63571; +Cc: Ludovic Courtès
This test was being skipped since
ea6fb108f6a3a53d48ea187b1f82b5f7ffce00a7.
* tests/upstream.scm ("coalesce-sources same version"): Compare a
serialized form of <upstream-source>.
---
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)
\f
(test-begin "upstream")
-;; FIXME: Temporarily skipping this test; see <https://bugs.gnu.org/34229>.
-(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)
--
2.40.1
^ permalink raw reply related [flat|nested] 38+ messages in thread* [bug#63571] [PATCH v2 12/19] import: cpan: Remove unary 'string-append' call.
2023-05-29 14:44 ` Ludovic Courtès
` (10 preceding siblings ...)
2023-05-29 14:45 ` [bug#63571] [PATCH v2 11/19] tests: upstream: Restore test that was skipped Ludovic Courtès
@ 2023-05-29 14:45 ` Ludovic Courtès
2023-05-29 14:45 ` [bug#63571] [PATCH v2 13/19] import: cpan: Represent dependencies as <upstream-input> records Ludovic Courtès
` (7 subsequent siblings)
19 siblings, 0 replies; 38+ messages in thread
From: Ludovic Courtès @ 2023-05-29 14:45 UTC (permalink / raw)
To: 63571; +Cc: Ludovic Courtès
* 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)))
--
2.40.1
^ permalink raw reply related [flat|nested] 38+ messages in thread* [bug#63571] [PATCH v2 13/19] import: cpan: Represent dependencies as <upstream-input> records.
2023-05-29 14:44 ` Ludovic Courtès
` (11 preceding siblings ...)
2023-05-29 14:45 ` [bug#63571] [PATCH v2 12/19] import: cpan: Remove unary 'string-append' call Ludovic Courtès
@ 2023-05-29 14:45 ` Ludovic Courtès
2023-05-29 14:45 ` [bug#63571] [PATCH v2 14/19] import: cpan: Updater provides input list Ludovic Courtès
` (6 subsequent siblings)
19 siblings, 0 replies; 38+ messages in thread
From: Ludovic Courtès @ 2023-05-29 14:45 UTC (permalink / raw)
To: 63571; +Cc: Ludovic Courtès
* 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 <upstream-input>.
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 <mhw@netris.org>
;;; Copyright © 2016 Alex Sassmannshausen <alex@pompo.co>
;;; Copyright © 2017, 2018 Tobias Geerinckx-Rice <me@tobias.gr>
-;;; Copyright © 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020, 2021, 2023 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2022 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;;
;;; 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 <upstream-input> 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 <upstream-input> for dependencies of RELEASE, a
+<cpan-release>."
+ (define (upstream-input<? a b)
+ (string<? (upstream-input-downstream-name a)
+ (upstream-input-downstream-name b)))
+
+ (sort (delete-duplicates
+ (filter-map cran-dependency->upstream-input
+ (cpan-release-dependencies release)))
+ upstream-input<?))
+
(define (cpan-module->sexp release)
"Return the 'package' s-expression for a CPAN module from the release data
in RELEASE, a <cpan-release> 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 _ ...))
- (string<? a b))))))))
-
- (define (maybe-inputs guix-name inputs)
+ (define (maybe-inputs input-type inputs)
(match inputs
(()
'())
((inputs ...)
- (list (list guix-name
- (list 'quasiquote inputs))))))
+ `((,input-type (list ,@(map (compose string->symbol
+ 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 <bavier@member.fsf.org>
;;; Copyright © 2016 Alex Sassmannshausen <alex@pompo.co>
-;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020, 2023 Ludovic Courtès <ludo@gnu.org>
;;;
;;; 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!)
--
2.40.1
^ permalink raw reply related [flat|nested] 38+ messages in thread* [bug#63571] [PATCH v2 14/19] import: cpan: Updater provides input list.
2023-05-29 14:44 ` Ludovic Courtès
` (12 preceding siblings ...)
2023-05-29 14:45 ` [bug#63571] [PATCH v2 13/19] import: cpan: Represent dependencies as <upstream-input> records Ludovic Courtès
@ 2023-05-29 14:45 ` Ludovic Courtès
2023-05-29 14:45 ` [bug#63571] [PATCH v2 15/19] import: elpa: " Ludovic Courtès
` (5 subsequent siblings)
19 siblings, 0 replies; 38+ messages in thread
From: Ludovic Courtès @ 2023-05-29 14:45 UTC (permalink / raw)
To: 63571; +Cc: Ludovic Courtès
* 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
--
2.40.1
^ permalink raw reply related [flat|nested] 38+ messages in thread* [bug#63571] [PATCH v2 15/19] import: elpa: Updater provides input list.
2023-05-29 14:44 ` Ludovic Courtès
` (13 preceding siblings ...)
2023-05-29 14:45 ` [bug#63571] [PATCH v2 14/19] import: cpan: Updater provides input list Ludovic Courtès
@ 2023-05-29 14:45 ` Ludovic Courtès
2023-05-29 14:45 ` [bug#63571] [PATCH v2 16/19] import: gem: Factorize "bundler" special case for name mapping Ludovic Courtès
` (4 subsequent siblings)
19 siblings, 0 replies; 38+ messages in thread
From: Ludovic Courtès @ 2023-05-29 14:45 UTC (permalink / raw)
To: 63571; +Cc: Ludovic Courtès, Andrew Tropin, Liliana Marie Prikler
* 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 | 30 +++++++++++++++++++++++++--
tests/elpa.scm | 48 ++++++++++++++++++++++++++++++++++++++++++--
2 files changed, 74 insertions(+), 4 deletions(-)
diff --git a/guix/import/elpa.scm b/guix/import/elpa.scm
index 1313a8aa67..e65cf6683b 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
+<upstream-input>."
+ (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,19 @@ (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
+ (if (eq? 'nil reqs)
+ '()
+ 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 <beffa@fbengineering.ch>
-;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020, 2023 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
;;;
@@ -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"))])))
+\f
(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")))
--
2.40.1
^ permalink raw reply related [flat|nested] 38+ messages in thread* [bug#63571] [PATCH v2 16/19] import: gem: Factorize "bundler" special case for name mapping.
2023-05-29 14:44 ` Ludovic Courtès
` (14 preceding siblings ...)
2023-05-29 14:45 ` [bug#63571] [PATCH v2 15/19] import: elpa: " Ludovic Courtès
@ 2023-05-29 14:45 ` Ludovic Courtès
2023-05-29 14:45 ` [bug#63571] [PATCH v2 17/19] import: gem: Updater provides input list Ludovic Courtès
` (3 subsequent siblings)
19 siblings, 0 replies; 38+ messages in thread
From: Ludovic Courtès @ 2023-05-29 14:45 UTC (permalink / raw)
To: 63571; +Cc: Ludovic Courtès, Christopher Baines
* guix/import/gem.scm (ruby-package-name): Add "bundler" special case.
(gem->guix-package): Adjust accordingly.
* tests/gem.scm ("gem-recursive-import")
("gem-recursive-import with a specific version"): Remove "ruby-bundler"
from the expected packages.
---
guix/import/gem.scm | 14 ++++++--------
tests/gem.scm | 30 ------------------------------
2 files changed, 6 insertions(+), 38 deletions(-)
diff --git a/guix/import/gem.scm b/guix/import/gem.scm
index 4e2be0f5f8..87a75bdaa6 100644
--- a/guix/import/gem.scm
+++ b/guix/import/gem.scm
@@ -93,9 +93,11 @@ (define* (rubygems-fetch name #:optional version)
(define (ruby-package-name name)
"Given the NAME of a package on RubyGems, return a Guix-compliant name for
the package."
- (if (string-prefix? "ruby-" name)
- (snake-case name)
- (string-append "ruby-" (snake-case name))))
+ (if (string=? name "bundler")
+ name ;special case: no prefix
+ (if (string-prefix? "ruby-" name)
+ (snake-case name)
+ (string-append "ruby-" (snake-case name)))))
(define (make-gem-sexp name version hash home-page synopsis description
dependencies licenses)
@@ -135,11 +137,7 @@ (define* (gem->guix-package package-name #:key (repo 'rubygems) version
(let* ((dependencies-names (map gem-dependency-name
(gem-dependencies-runtime
(gem-dependencies gem))))
- (dependencies (map (lambda (dep)
- (if (string=? dep "bundler")
- "bundler" ; special case, no prefix
- (ruby-package-name dep)))
- dependencies-names))
+ (dependencies (map ruby-package-name dependencies-names))
(licenses (map string->license (gem-licenses gem))))
(values (make-gem-sexp (gem-name gem) (gem-version gem)
(gem-sha256 gem) (gem-home-page gem)
diff --git a/tests/gem.scm b/tests/gem.scm
index 6aa0d279dc..023415de7b 100644
--- a/tests/gem.scm
+++ b/tests/gem.scm
@@ -181,21 +181,6 @@ (define test-bundler-json
('description "Another cool gem")
('home-page "https://example.com")
('license #f)) ;no licensing info
- ('package
- ('name "ruby-bundler")
- ('version "1.14.2")
- ('source
- ('origin
- ('method 'url-fetch)
- ('uri ('rubygems-uri "bundler" 'version))
- ('sha256
- ('base32
- "1446xiz7zg0bz7kgx9jv84y0s4hpsg61dj5l3qb0i00avc1kxd9v"))))
- ('build-system 'ruby-build-system)
- ('synopsis "Ruby gem bundler")
- ('description "Ruby gem bundler")
- ('home-page "https://bundler.io/")
- ('license 'license:expat))
('package
('name "ruby-foo")
('version "1.0.0")
@@ -248,21 +233,6 @@ (define test-bundler-json
('description "Another cool gem")
('home-page "https://example.com")
('license #f)) ;no licensing info
- ('package
- ('name "ruby-bundler")
- ('version "1.14.2")
- ('source
- ('origin
- ('method 'url-fetch)
- ('uri ('rubygems-uri "bundler" 'version))
- ('sha256
- ('base32
- "1446xiz7zg0bz7kgx9jv84y0s4hpsg61dj5l3qb0i00avc1kxd9v"))))
- ('build-system 'ruby-build-system)
- ('synopsis "Ruby gem bundler")
- ('description "Ruby gem bundler")
- ('home-page "https://bundler.io/")
- ('license 'license:expat))
('package
('name "ruby-foo")
('version "2.0.0")
--
2.40.1
^ permalink raw reply related [flat|nested] 38+ messages in thread* [bug#63571] [PATCH v2 17/19] import: gem: Updater provides input list.
2023-05-29 14:44 ` Ludovic Courtès
` (15 preceding siblings ...)
2023-05-29 14:45 ` [bug#63571] [PATCH v2 16/19] import: gem: Factorize "bundler" special case for name mapping Ludovic Courtès
@ 2023-05-29 14:45 ` Ludovic Courtès
2023-05-29 14:45 ` [bug#63571] [PATCH v2 18/19] upstream: Honor package properties for ignored and extra inputs Ludovic Courtès
` (2 subsequent siblings)
19 siblings, 0 replies; 38+ messages in thread
From: Ludovic Courtès @ 2023-05-29 14:45 UTC (permalink / raw)
To: 63571; +Cc: Ludovic Courtès, Christopher Baines
* guix/import/gem.scm (import-release): Add 'inputs' field.
* tests/gem.scm ("package-latest-release"): New test.
---
guix/import/gem.scm | 13 +++++++++++--
tests/gem.scm | 31 +++++++++++++++++++++++++++++++
2 files changed, 42 insertions(+), 2 deletions(-)
diff --git a/guix/import/gem.scm b/guix/import/gem.scm
index 87a75bdaa6..56cbc681a1 100644
--- a/guix/import/gem.scm
+++ b/guix/import/gem.scm
@@ -2,7 +2,7 @@
;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com>
;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
-;;; Copyright © 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020, 2021, 2023 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;; Copyright © 2022 Taiju HIGASHI <higashi@taiju.info>
@@ -176,12 +176,21 @@ (define* (import-release package #:key (version #f))
"Return an <upstream-source> for the latest release of PACKAGE."
(let* ((gem-name (guix-package->gem-name package))
(gem (rubygems-fetch gem-name))
+ (inputs (map (lambda (dependency)
+ (let ((name (gem-dependency-name dependency)))
+ (upstream-input
+ (name name)
+ (downstream-name
+ (ruby-package-name name))
+ (type 'propagated))))
+ (gem-dependencies-runtime (gem-dependencies gem))))
(version (or version (gem-version gem)))
(url (rubygems-uri gem-name version)))
(upstream-source
(package (package-name package))
(version version)
- (urls (list url)))))
+ (urls (list url))
+ (inputs inputs))))
(define %gem-updater
(upstream-updater
diff --git a/tests/gem.scm b/tests/gem.scm
index 023415de7b..a2b5e39077 100644
--- a/tests/gem.scm
+++ b/tests/gem.scm
@@ -4,6 +4,7 @@
;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;; Copyright © 2022 Taiju HIGASHI <higashi@taiju.info>
+;;; Copyright © 2023 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -22,6 +23,9 @@
(define-module (test-gem)
#:use-module (guix import gem)
+ #:use-module (guix upstream)
+ #:use-module ((guix download) #:select (url-fetch))
+ #:use-module ((guix build-system ruby) #:select (rubygems-uri))
#:use-module (guix base32)
#:use-module (gcrypt hash)
#:use-module (guix tests)
@@ -253,4 +257,31 @@ (define test-bundler-json
(x
(pk 'fail x #f)))))
+(test-equal "package-latest-release"
+ (list '("https://rubygems.org/downloads/foo-1.0.0.gem")
+ (list (upstream-input
+ (name "bundler")
+ (downstream-name name)
+ (type 'propagated))
+ (upstream-input
+ (name "bar")
+ (downstream-name "ruby-bar")
+ (type 'propagated))))
+ (mock ((guix http-client) http-fetch
+ (lambda (url . rest)
+ (match url
+ ("https://rubygems.org/api/v1/gems/foo.json"
+ (values (open-input-string test-foo-json)
+ (string-length test-foo-json)))
+ (_ (error "Unexpected URL: " url)))))
+ (let ((source (package-latest-release
+ (dummy-package "ruby-foo"
+ (version "0.1.2")
+ (source (dummy-origin
+ (method url-fetch)
+ (uri (rubygems-uri "foo"
+ version))))))))
+ (list (upstream-source-urls source)
+ (upstream-source-inputs source)))))
+
(test-end "gem")
--
2.40.1
^ permalink raw reply related [flat|nested] 38+ messages in thread* [bug#63571] [PATCH v2 18/19] upstream: Honor package properties for ignored and extra inputs.
2023-05-29 14:44 ` Ludovic Courtès
` (16 preceding siblings ...)
2023-05-29 14:45 ` [bug#63571] [PATCH v2 17/19] import: gem: Updater provides input list Ludovic Courtès
@ 2023-05-29 14:45 ` Ludovic Courtès
2023-05-29 14:45 ` [bug#63571] [PATCH v2 19/19] gnu: Add updater input properties for R and Python packages Ludovic Courtès
2023-05-31 21:54 ` bug#63571: [PATCH 00/14] 'guix refresh -u' updates input fields Ludovic Courtès
19 siblings, 0 replies; 38+ messages in thread
From: Ludovic Courtès @ 2023-05-29 14:45 UTC (permalink / raw)
To: 63571
Cc: Ludovic Courtès, Christopher Baines, Josselin Poiret,
Ludovic Courtès, Mathieu Othacehe, Ricardo Wurmus,
Simon Tournier, Tobias Geerinckx-Rice
* guix/upstream.scm (update-package-inputs)[filtered-inputs]
[regular-inputs, native-inputs, propagated-inputs]: New procedures.
Use them in 'update-field' calls.
* tests/guix-refresh.sh (GUIX_TEST_UPDATER_TARGETS): Add "libreoffice"
to the dependencies of "the-test-package". Add 'updater-ignored-inputs'
property to "the-test-package".
* doc/guix.texi (Invoking guix refresh): Document it.
---
doc/guix.texi | 30 ++++++++++++++++++++++++++++++
guix/upstream.scm | 39 ++++++++++++++++++++++++++++++++++++---
tests/guix-refresh.sh | 5 +++--
3 files changed, 69 insertions(+), 5 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index c54a72bfaa..33528e997e 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -14358,6 +14358,36 @@ Invoking guix refresh
@xref{Creating a Channel}, on how to create a channel.
+This command updates the version and source code hash of the package.
+Depending on the updater being used, it can also update the various
+@samp{inputs} fields of the package. In some cases, the updater might
+get inputs wrong---it might not know about an extra input that's
+necessary, or it might add an input that should be avoided.
+
+@cindex @code{updater-extra-inputs}, package property
+@cindex @code{updater-ignored-inputs}, package property
+To address that, packagers can add properties stating inputs that should
+be added to those found by the updater or inputs that should be ignored:
+the @code{updater-extra-inputs} and @code{updater-ignored-inputs}
+properties pertain to ``regular'' inputs, and there are equivalent
+properties for @samp{native} and @samp{propagated} inputs. In the
+example below, we tell the updater that we need @samp{openmpi} as an
+additional input:
+
+@lisp
+(define-public python-mpi4py
+ (package
+ (name "python-mpi4py")
+ ;; @dots{}
+ (inputs (list openmpi))
+ (properties
+ '((updater-extra-inputs . ("openmpi"))))))
+@end lisp
+
+That way, @command{guix refresh -u python-mpi4py} will leave the
+@samp{openmpi} input, even if it is not among the inputs it would
+normally add.
+
@item --select=[@var{subset}]
@itemx -s @var{subset}
Select all the packages in @var{subset}, one of @code{core}, @code{non-core}
diff --git a/guix/upstream.scm b/guix/upstream.scm
index 53e473715c..33248d645c 100644
--- a/guix/upstream.scm
+++ b/guix/upstream.scm
@@ -557,11 +557,44 @@ (define (update-package-inputs package source)
(G_ "~a: expected '~a' value: ~s~%")
(package-name package) field new))))
+ (define (filtered-inputs source-inputs extra-property ignore-property)
+ ;; Return a procedure that behaves like SOURCE-INPUTS but additionally
+ ;; honors EXTRA-PROPERTY and IGNORE-PROPERTY from PACKAGE.
+ (lambda (source)
+ (let* ((inputs (source-inputs source))
+ (properties (package-properties package))
+ (ignore (or (assoc-ref properties ignore-property) '()))
+ (extra (or (assoc-ref properties extra-property) '())))
+ (append (if (null? ignore)
+ inputs
+ (remove (lambda (input)
+ (member (upstream-input-downstream-name input)
+ ignore))
+ inputs))
+ (map (lambda (name)
+ (upstream-input
+ (name name)
+ (downstream-name name)))
+ extra)))))
+
+ (define regular-inputs
+ (filtered-inputs upstream-source-regular-inputs
+ 'updater-extra-inputs
+ 'updater-ignored-inputs))
+ (define native-inputs
+ (filtered-inputs upstream-source-native-inputs
+ 'updater-extra-native-inputs
+ 'updater-ignored-native-inputs))
+ (define propagated-inputs
+ (filtered-inputs upstream-source-propagated-inputs
+ 'updater-extra-propagated-inputs
+ 'updater-ignored-propagated-inputs))
+
(for-each update-field
'(inputs native-inputs propagated-inputs)
- (list upstream-source-regular-inputs
- upstream-source-native-inputs
- upstream-source-propagated-inputs)
+ (list regular-inputs
+ native-inputs
+ propagated-inputs)
(list package-inputs
package-native-inputs
package-propagated-inputs)))
diff --git a/tests/guix-refresh.sh b/tests/guix-refresh.sh
index 9d7a57a36e..51d34c4b51 100644
--- a/tests/guix-refresh.sh
+++ b/tests/guix-refresh.sh
@@ -35,7 +35,7 @@ GUIX_TEST_UPDATER_TARGETS='
("libreoffice" "" (("1.0" "file:///dev/null")))
("idutils" "" (("'$idutils_version'" "file:///dev/null")))
("the-test-package" "" (("5.5" "file://'$PWD/$module_dir'/source"
- ("grep" "sed")))))'
+ ("grep" "sed" "libreoffice")))))'
# No newer version available.
guix refresh -t test idutils # XXX: should return non-zero?
@@ -93,7 +93,8 @@ cat > "$module_dir/sample.scm"<<EOF
(sha256
(base32
"086vqwk2wl8zfs47sq2xpjc9k066ilmb8z6dn0q6ymwjzlm196cd"))))
- (inputs (list coreutils tar))))
+ (inputs (list coreutils tar))
+ (properties '((updater-ignored-inputs . ("libreoffice"))))))
EOF
guix refresh -t test -L "$module_dir" the-test-package
guix refresh -t test -L "$module_dir" the-test-package -u \
--
2.40.1
^ permalink raw reply related [flat|nested] 38+ messages in thread* [bug#63571] [PATCH v2 19/19] gnu: Add updater input properties for R and Python packages.
2023-05-29 14:44 ` Ludovic Courtès
` (17 preceding siblings ...)
2023-05-29 14:45 ` [bug#63571] [PATCH v2 18/19] upstream: Honor package properties for ignored and extra inputs Ludovic Courtès
@ 2023-05-29 14:45 ` Ludovic Courtès
2023-05-31 21:54 ` bug#63571: [PATCH 00/14] 'guix refresh -u' updates input fields Ludovic Courtès
19 siblings, 0 replies; 38+ messages in thread
From: Ludovic Courtès @ 2023-05-29 14:45 UTC (permalink / raw)
To: 63571; +Cc: Ludovic Courtès, Ricardo Wurmus
* gnu/packages/cran.scm (r-glue, r-xfun, r-vctrs)
(r-lifecycle): Turn comment about r-knitr into 'properties' field.
* gnu/packages/mpi.scm (python-mpi4py)[properties]: New field.
---
gnu/packages/cran.scm | 36 ++++++++++++++++--------------------
gnu/packages/mpi.scm | 2 ++
2 files changed, 18 insertions(+), 20 deletions(-)
diff --git a/gnu/packages/cran.scm b/gnu/packages/cran.scm
index 4fafcaea9c..fa6f86c587 100644
--- a/gnu/packages/cran.scm
+++ b/gnu/packages/cran.scm
@@ -5085,11 +5085,10 @@ (define-public r-glue
(base32
"1gzxk5jgdh2xq9r7z09xs306ygzf27vhg3pyfl7ck1755gqii9cx"))))
(build-system r-build-system)
- ;; knitr depends on glue, so we can't add knitr here to build the
- ;; vignettes.
- #;
- (native-inputs
- `(("r-knitr" ,r-knitr)))
+ (properties
+ ;; knitr depends on glue, so we can't add knitr here to build the
+ ;; vignettes.
+ '((updater-ignored-native-inputs . ("r-knitr"))))
(home-page "https://github.com/tidyverse/glue")
(synopsis "Interpreted string literals")
(description
@@ -8777,10 +8776,9 @@ (define-public r-xfun
(sha256
(base32 "1jan2ggfywm1g05zszyy8d492wj7vpy35682lrnlklrx4jxsmv6h"))))
(build-system r-build-system)
- ;; knitr itself depends on xfun
- #;
- (native-inputs
- `(("r-knitr" ,r-knitr)))
+ (properties
+ ;; knitr itself depends on xfun
+ '((updater-ignored-native-inputs . ("r-knitr"))))
(home-page "https://github.com/yihui/xfun")
(synopsis "Miscellaneous functions")
(description
@@ -8867,11 +8865,10 @@ (define-public r-vctrs
(build-system r-build-system)
(propagated-inputs
(list r-cli r-glue r-lifecycle r-rlang))
- ;; We can't have r-knitr among the inputs here, because r-vctrs ends up
- ;; being an eventual input to r-knitr.
- #;
- (native-inputs
- (list r-knitr))
+ (properties
+ ;; We can't have r-knitr among the inputs here, because r-vctrs ends up
+ ;; being an eventual input to r-knitr.
+ '((updater-ignored-native-inputs . ("r-knitr"))))
(home-page "https://github.com/r-lib/vctrs")
(synopsis "Vector helpers")
(description
@@ -25253,15 +25250,14 @@ (define-public r-lifecycle
(sha256
(base32
"1hk9mblhap429fk77qpgc4hv0j91q5wpahi0y76w118m471zsnb4"))))
- (properties `((upstream-name . "lifecycle")))
(build-system r-build-system)
(propagated-inputs
(list r-cli r-glue r-rlang))
- ;; We can't add this here because via r-stringr this package ends up being
- ;; an input to r-knitr.
- #;
- (native-inputs
- (list r-knitr)) ; for vignettes
+ (properties
+ ;; We can't add this here because via r-stringr this package ends up
+ ;; being an input to r-knitr.
+ '((updater-ignored-native-inputs . ("r-knitr"))
+ (upstream-name . "lifecycle")))
(home-page "https://github.com/r-lib/lifecycle")
(synopsis "Manage the life cycle of your package functions")
(description
diff --git a/gnu/packages/mpi.scm b/gnu/packages/mpi.scm
index fb874484bf..c78799e640 100644
--- a/gnu/packages/mpi.scm
+++ b/gnu/packages/mpi.scm
@@ -422,6 +422,8 @@ (define-public python-mpi4py
#t)))))
(inputs
(list openmpi))
+ (properties
+ '((updater-extra-inputs . ("openmpi"))))
(home-page "https://bitbucket.org/mpi4py/mpi4py/")
(synopsis "Python bindings for the Message Passing Interface standard")
(description "MPI for Python (mpi4py) provides bindings of the Message
--
2.40.1
^ permalink raw reply related [flat|nested] 38+ messages in thread* bug#63571: [PATCH 00/14] 'guix refresh -u' updates input fields
2023-05-29 14:44 ` Ludovic Courtès
` (18 preceding siblings ...)
2023-05-29 14:45 ` [bug#63571] [PATCH v2 19/19] gnu: Add updater input properties for R and Python packages Ludovic Courtès
@ 2023-05-31 21:54 ` Ludovic Courtès
19 siblings, 0 replies; 38+ messages in thread
From: Ludovic Courtès @ 2023-05-31 21:54 UTC (permalink / raw)
To: 63571-done
Ludovic Courtès <ludo@gnu.org> skribis:
> This is addressed in v2 of this patch series, along with other
> improvements (changes since v1):
>
> • honors ‘updater-extra-inputs’ and ‘updater-ignored-inputs’ package
> properties (and similarly for native and propagated inputs);
>
> • add those properties to a few packages;
>
> • ‘cran’ updater keeps inputs alphabetically sorted;
>
> • ‘gem’ updater now updates inputs as well.
>
> Surely this will reveal limitations of updaters/importers but I’d like
> to see it as an opportunity to improve them; more importantly, we have
> to reduce the maintenance cost of all these imported packages, and this
> is a step in that direction.
>
> If there are no objections, I’d like to apply this series within a few
> days.
Pushed as 9f7cd1fcaf99c8e8430d0b29335220701664dc54!
Let me know how it works for you!
Ludo’.
^ permalink raw reply [flat|nested] 38+ messages in thread