;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 David Thompson <davet@gnu.org>
;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
;;; Copyright © 2022 Vivien Kraus <vivien@planete-kraus.eu>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (test-pypi)
#:use-module (guix import 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
which mkdir-p dump-port
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)
#:use-module (srfi srfi-35)
#:use-module (srfi srfi-64)
#: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}."
(scm->json-string
`((info
. ((version . "1.0.0")
(name . ,name)
(license . "GNU LGPL")
(summary . "summary")
(home_page . "http://example.com")
(classifiers . #())
(download_url . "")))
(urls . #())
(releases
. ((1.0.0
. #(((url . ,(format #f "~a/~a-1.0.0.egg"
(%local-url #:path "")
(or name-in-url name)))
(packagetype . "bdist_egg"))
((url . ,(format #f "~a/~a-1.0.0.tar.gz"
(%local-url #:path "")
(or name-in-url name)))
(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)))
(packagetype . "bdist_wheel")))))))))
(define test-specifications
'("Fizzy [foo, bar]"
"PickyThing<1.6,>1.9,!=1.9.6,<2.0a0,==2.4c1"
"SomethingWithMarker[foo]>1.0;python_version<\"2.7\""
"requests [security,tests] >= 2.8.1, == 2.8.* ; python_version < \"2.7\""
"pip @ https://github.com/pypa/pip/archive/1.3.1.zip#\
sha1=da9234ee9982d4bbb3c72346a6de940a148ea686"))
(define test-requires.txt "\
# A comment
# A comment after a space
foo ~= 3
bar != 2
[test]
pytest (>=2.5.0)
")
;; Beaker contains only optional dependencies.
(define test-requires.txt-beaker "\
[crypto]
pycryptopp>=0.5.12
[cryptography]
cryptography
[testsuite]
Mock
coverage
")
(define test-metadata "\
Classifier: Programming Language :: Python :: 3.7
Requires-Dist: baz ~= 3
Requires-Dist: bar != 2
Provides-Extra: test
Requires-Dist: pytest (>=2.5.0) ; extra == 'test'
")
(define test-metadata-with-extras "
Classifier: Programming Language :: Python :: 3.7
Requires-Python: >=2.7, !=3.0.*, !=3.1.*, !=3.2.*, !=3.3.*
Requires-Dist: wrapt (<2,>=1)
Requires-Dist: bar
Provides-Extra: dev
Requires-Dist: tox ; extra == 'dev'
Requires-Dist: bumpversion (<1) ; extra == 'dev'
")
;;; Provides-Extra can appear before Requires-Dist.
(define test-metadata-with-extras-jedi "\
Requires-Python: >=2.7, !=3.0.*, !=3.1.*, !=3.2.*, !=3.3.*
Provides-Extra: testing
Requires-Dist: parso (>=0.3.0)
Provides-Extra: testing
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))
(define (file-dump file)
"Return a procedure that dumps FILE to the given port."
(lambda (output)
(call-with-input-file file
(lambda (input)
(dump-port input output)))))
(define-syntax-rule (with-pypi responses body ...)
(with-http-server responses
(parameterize ((%pypi-base-url (%local-url #:path "/")))
body ...)))
(test-begin "pypi")
(test-equal "guix-package->pypi-name, old URL style"
"psutil"
(guix-package->pypi-name
(dummy-package "foo&qu?id=90ef692e9b48732ae2e3921ff5d101e186506a85'>read-print: 'canonicalize-comment' leaves top-level comments unchanged....This lets users use three leading semicolons, for instance, in top-level
comments.
* guix/read-print.scm (canonicalize-comment): Add INDENT parameter and
honor it.
(pretty-print-with-comments): Change default value of #:format-comment.
Call FORMAT-COMMENT with INDENT as the second argument.
* tests/read-print.scm: Adjust test accordingly.
| Ludovic Courtès |
| 2022-08-08 | read-print: Add code to read and write sequences of expressions/blanks....* guix/read-print.scm (read-with-comments): Add #:blank-line? and honor it.
(read-with-comments/sequence, pretty-print-with-comments/splice): New
procedures.
* tests/read-print.scm (test-pretty-print/sequence): New macro.
Add tests using it.
| Ludovic Courtès |
| 2022-08-08 | read-print: Recognize page breaks....* guix/read-print.scm (<page-break>, page-break?, page-break)
(char-set:whitespace-sans-page-break): New variables.
(space?): New procedure.
(read-vertical-space): Use it.
(read-until-end-of-line): New procedure.
(read-with-comments): Add #\page case.
(pretty-print-with-comments): Add 'page-break?' case.
* tests/read-print.scm ("read-with-comments: top-level page break"): New
test.
Add round-trip test with page break within an sexp.
| Ludovic Courtès |
| 2022-08-08 | read-print: Read and render vertical space....* guix/read-print.scm (<vertical-space>, vertical-space?)
(vertical-space, vertical-space-height): New variables.
(combine-vertical-space, canonicalize-vertical-space)
(read-vertical-space): New procedures.
(read-with-comments): Use it in the #\newline case.
(pretty-print-with-comments): Add #:format-vertical-space and honor it.
Add case for 'vertical-space?'.
* guix/scripts/style.scm (format-package-definition): Pass
#:format-vertical-space to 'object->string*'.
* tests/read-print.scm ("read-with-comments: list with blank line")
("read-with-comments: list with multiple blank lines")
("read-with-comments: top-level blank lines")
("pretty-print-with-comments, canonicalize-vertical-space"): New tests.
Add a couple of additional round-trip tests.
| Ludovic Courtès |
| 2022-08-08 | style: Move reader and printer to (guix read-print)....* guix/scripts/style.scm (<comment>, read-with-comments)
(vhashq, %special-forms, %newline-forms, prefix?)
(special-form-lead, newline-form?, escaped-string)
(string-width, canonicalize-comment, pretty-print-with-comments)
(object->string*): Move to...
* guix/read-print.scm: ... here. New file.
* guix/scripts/import.scm: Adjust accordingly.
* tests/style.scm: Move 'test-pretty-print' and tests to...
* tests/read-print.scm: ... here. New file.
* Makefile.am (MODULES): Add 'guix/read-print.scm'.
(SCM_TESTS): Add 'tests/read-print.scm'.
| Ludovic Courtès |
t;/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=? default-sha256/base32 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"
(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=? default-sha256/base32 hash))
(x
(pk 'fail x #f))))))
(test-assert "pypi->guix-package, no usable requirement file."
(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=? default-sha256/base32 hash))
(x
(pk 'fail x #f))))))
(test-assert "pypi->guix-package, package name contains \"-\" followed by digits"
(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=? 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)
;; Local Variables:
;; eval: (put 'with-pypi 'scheme-indent-function 1)
;; End:
