diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/derivations.scm | 31 | ||||
| -rw-r--r-- | tests/go.scm | 6 | ||||
| -rw-r--r-- | tests/gremlin.scm | 2 | ||||
| -rw-r--r-- | tests/guix-build.sh | 11 | ||||
| -rw-r--r-- | tests/guix-package.sh | 4 | ||||
| -rw-r--r-- | tests/guix-shell-export-manifest.sh | 3 | ||||
| -rw-r--r-- | tests/import-utils.scm | 6 | ||||
| -rw-r--r-- | tests/lint.scm | 62 | ||||
| -rw-r--r-- | tests/pack.scm | 40 | ||||
| -rw-r--r-- | tests/packages.scm | 25 | ||||
| -rw-r--r-- | tests/pypi.scm | 101 | ||||
| -rw-r--r-- | tests/toml.scm | 469 | ||||
| -rw-r--r-- | tests/transformations.scm | 31 |
13 files changed, 767 insertions, 24 deletions
diff --git a/tests/derivations.scm b/tests/derivations.scm index 0e87778981..efcd21f324 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012-2023 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012-2024 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -29,7 +29,8 @@ #:use-module (guix tests git) #:use-module (guix tests http) #:use-module ((guix packages) #:select (package-derivation base32)) - #:use-module ((guix build utils) #:select (executable-file?)) + #:use-module ((guix build utils) + #:select (executable-file? strip-store-file-name)) #:use-module ((guix hash) #:select (file-hash*)) #:use-module ((git oid) #:select (oid->string)) #:use-module ((git reference) #:select (reference-name->oid)) @@ -1157,6 +1158,32 @@ #:mode (build-mode check)) (list drv dep)))))) +(test-equal "derivation-build-plan, topological ordering" + (make-list 5 '("0.drv" "1.drv" "2.drv" "3.drv" "4.drv")) + (with-store store + (define (test _) + (let* ((simple-derivation + (lambda (name . deps) + (build-expression->derivation + store name + `(begin ,(random-text) (mkdir %output)) + #:inputs (map (lambda (n dep) + (list (number->string n) dep)) + (iota (length deps)) + deps)))) + (drv0 (simple-derivation "0")) + (drv1 (simple-derivation "1" drv0)) + (drv2 (simple-derivation "2" drv1)) + (drv3 (simple-derivation "3" drv2 drv0)) + (drv4 (simple-derivation "4" drv3 drv1))) + (map (compose strip-store-file-name derivation-file-name) + (derivation-build-plan store (list (derivation-input drv4)))))) + + ;; This is probabilistic: if the traversal is buggy, it may or may not + ;; produce the wrong ordering, depending on a variety of actors. Thus, + ;; try multiple times. + (map test (iota 5)))) + (test-assert "derivation-input-fold" (let* ((builder (add-text-to-store %store "my-builder.sh" "echo hello, world > \"$out\"\n" diff --git a/tests/go.scm b/tests/go.scm index f925c485c1..1ba089c788 100644 --- a/tests/go.scm +++ b/tests/go.scm @@ -136,7 +136,9 @@ replace ( (define fixtures-go-check-test (let ((version - "{\"Version\":\"v0.0.0-20201130134442-10cb98267c6c\",\"Time\":\"2020-11-30T13:44:42Z\"}") + "{\"Version\":\"v0.0.0-20201130134442-10cb98267c6c\",\"Time\":\"2020-11-30T13:44:42Z\"}") + (go.info + "{\"Version\":\"v0.0.0-20201130134442-10cb98267c6c\",\"Time\":\"2020-11-30T13:44:42Z\"}") (go.mod "module gopkg.in/check.v1 @@ -174,6 +176,8 @@ require github.com/kr/pretty v0.2.1 . ,go.mod) ("https://proxy.golang.org/github.com/go-check/check/@latest" . ,version) + ("https://proxy.golang.org/github.com/go-check/check/@v/v0.0.0-20201130134442-10cb98267c6c.info" + . ,go.info) ("https://github.com/go-check/check?go-get=1" . ,go-get) ("https://pkg.go.dev/github.com/go-check/check" diff --git a/tests/gremlin.scm b/tests/gremlin.scm index 3dbb8d3643..280b1d8819 100644 --- a/tests/gremlin.scm +++ b/tests/gremlin.scm @@ -136,6 +136,7 @@ (with-directory-excursion directory (call-with-output-file "t.c" (lambda (port) + (display "#include <stdio.h>\n" port) (display "int main () { puts(\"hello\"); }" port))) (invoke c-compiler "t.c" "-Wl,--enable-new-dtags" "-Wl,-rpath=/foo" "-Wl,-rpath=/bar") @@ -164,6 +165,7 @@ (with-directory-excursion directory (call-with-output-file "t.c" (lambda (port) + (display "#include <stdio.h>\n" port) (display "int main () { puts(\"hello\"); }" port))) (invoke c-compiler "t.c" diff --git a/tests/guix-build.sh b/tests/guix-build.sh index 36eac2b7e0..6d46d571a9 100644 --- a/tests/guix-build.sh +++ b/tests/guix-build.sh @@ -190,6 +190,17 @@ test `guix build -d --sources=transitive foo \ | grep -e 'foo\.tar\.gz' -e 'bar\.tar\.gz' -e 'bar\.dat' \ | wc -l` -eq 3 +# Building the inputs. +guix build -D hello -n +test `guix build -D hello -d \ + | grep -e 'glibc.*\.drv$' -e 'gcc.*\.drv$' -e 'binutils.*\.drv$' \ + | wc -l` -ge 3 + +# Building the dependents. +test `guix build -P1 libgit2 -P1 libssh -d \ + | grep -e 'guile-git.*\.drv$' -e 'guile-ssh.*\.drv$' \ + -e 'libgit2-[0-9].*\.drv$' -e 'libssh-[0-9].*\.drv$' \ + | wc -l` -eq 4 # Unbound variable in thunked field. cat > "$module_dir/foo.scm" <<EOF diff --git a/tests/guix-package.sh b/tests/guix-package.sh index 945d59cdfb..000cd4df11 100644 --- a/tests/guix-package.sh +++ b/tests/guix-package.sh @@ -2,6 +2,8 @@ # Copyright © 2012-2022 Ludovic Courtès <ludo@gnu.org> # Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> # Copyright © 2022 Josselin Poiret <dev@jpoiret.xyz> +# Copyright © 2022 Josselin Poiret <dev@jpoiret.xyz> +# Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org> # # This file is part of GNU Guix. # @@ -124,7 +126,7 @@ guix package --show=emacs@42 && false # Search. LC_MESSAGES=C export LC_MESSAGES -test "`guix package -s "An example GNU package" | grep ^name:`" = \ +test "`guix package -s "Example GNU package" | grep ^name:`" = \ "name: hello" test -z "`guix package -s "n0t4r341p4ck4g3"`" diff --git a/tests/guix-shell-export-manifest.sh b/tests/guix-shell-export-manifest.sh index 6c42c40f3b..fd0b4e47a9 100644 --- a/tests/guix-shell-export-manifest.sh +++ b/tests/guix-shell-export-manifest.sh @@ -1,5 +1,6 @@ # GNU Guix --- Functional package management for GNU # Copyright © 2022 Ludovic Courtès <ludo@gnu.org> +# Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org> # # This file is part of GNU Guix. # @@ -83,7 +84,7 @@ guix build -m "$manifest" -d | \ guix shell --export-manifest -D guile -D python-itsdangerous > "$manifest" guix build -m "$manifest" -d | grep "$(guix build libffi -d)" guix build -m "$manifest" -d | \ - grep "$(guix build -e '(@ (gnu packages python) python)' -d)" + grep "$(guix build -e '(@ (gnu packages python) python-sans-pip-wrapper)' -d)" # Test various combinations to make sure generated code uses interfaces # correctly. diff --git a/tests/import-utils.scm b/tests/import-utils.scm index bec38b0c30..607349203c 100644 --- a/tests/import-utils.scm +++ b/tests/import-utils.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015, 2017, 2022, 2023 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2015, 2017, 2022, 2023, 2024 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com> ;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev> @@ -65,6 +65,10 @@ Differences are hard to spot, e.g. in CLOS vs. GOOPS.")) "Code (@code{DelayedMatrix}, @code{MaMa}, or @code{MeMe}) should be wrapped." (beautify-description "Code (DelayedMatrix, MaMa, or MeMe) should be wrapped.")) +(test-equal "beautify-description: wrap function names in @code" + "The main functions are: @code{haplo.em()} and @code{haplo.power()}; FYI." + (beautify-description "The main functions are: haplo.em() and haplo.power(); FYI.")) + (test-equal "license->symbol" 'license:lgpl2.0 (license->symbol license:lgpl2.0)) diff --git a/tests/lint.scm b/tests/lint.scm index 95d82d7490..3e9dbd29db 100644 --- a/tests/lint.scm +++ b/tests/lint.scm @@ -11,6 +11,7 @@ ;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz> ;;; Copyright © 2021, 2023 Maxime Devos <maximedevos@telenet.be> +;;; Copyright © 2024 Gabriel Wicki <gabriel@erlikon.ch> ;;; ;;; This file is part of GNU Guix. ;;; @@ -120,6 +121,11 @@ (description "bad description.")))) (check-description-style pkg)))) +(test-equal "description: may start with texinfo markup" + '() + (check-description-style + (dummy-package "x" (description "@emph{Maxwell Equations of Software}")))) + (test-equal "description: may start with a digit" '() (let ((pkg (dummy-package "x" @@ -132,6 +138,30 @@ (description "x is a dummy package.")))) (check-description-style pkg))) +(test-equal "description: may start with beginning of package name" + '() + (let ((pkg (dummy-package "xyz-0.1" + (description "xyz is a dummy package.")))) + (check-description-style pkg))) + +(test-equal "description: may start with end of package name" + '() + (let ((pkg (dummy-package "foobar-xyz" + (description "xyz is a dummy package.")))) + (check-description-style pkg))) + +(test-equal "description: may start with non-hyphenated package name" + '() + (let ((pkg (dummy-package "foobar-xyz-minimal" + (description "foobar_xyz is a dummy package.")))) + (check-description-style pkg))) + +(test-equal "description: may start with end of package name" + '() + (let ((pkg (dummy-package "foo-bar" + (description "bar is some thing in foo.")))) + (check-description-style pkg))) + (test-equal "description: two spaces after end of sentence" "sentences in description should be followed by two spaces; possible infraction at 3" (single-lint-warning-message @@ -143,7 +173,7 @@ '() (let ((pkg (dummy-package "x" (description - "E.g. Foo, i.e. Bar resp. Baz (a.k.a. DVD).")))) + "O. Person e.g. Foo, i.e. Bar resp. Baz (a.k.a. DVD). Name et al. cf. some paper.")))) (check-description-style pkg))) (test-equal "description: may not contain trademark signs: ™" @@ -171,14 +201,14 @@ "description contains leading whitespace" (single-lint-warning-message (let ((pkg (dummy-package "x" - (description " Whitespace.")))) + (description " Whitespace.")))) (check-description-style pkg)))) (test-equal "description: trailing whitespace" "description contains trailing whitespace" (single-lint-warning-message (let ((pkg (dummy-package "x" - (description "Whitespace. ")))) + (description "Whitespace. ")))) (check-description-style pkg)))) (test-equal "description: pluralized 'This package'" @@ -189,12 +219,18 @@ (check-description-style pkg)))) (test-equal "description: grammar 'allows to'" - "description contains typo 'allows to'" + "description contains typo 'allows to '" (single-lint-warning-message (let ((pkg (dummy-package "x" (description "This package allows to do stuff.")))) (check-description-style pkg)))) +(test-equal "description: grammar 'allows to' 2" + '() + (let ((pkg (dummy-package "x" + (description "This package allows tokenization.")))) + (check-description-style pkg))) + (test-equal "synopsis: not a string" "invalid synopsis: #f" (single-lint-warning-message @@ -277,6 +313,12 @@ (check-synopsis-style pkg))) string<?)) +(test-equal "synopsis: starts with texinfo markup" + '() + (let ((pkg (dummy-package "x" + (synopsis "@code{help}")))) + (check-synopsis-style pkg))) + (test-equal "synopsis: too long" "synopsis should be less than 80 characters long" (single-lint-warning-message @@ -359,18 +401,18 @@ '() (check-compiler-for-target (dummy-package "x" - (arguments - (list #:make-flags - #~(list (string-append "CC=" (cc-for-target)))))))) + (arguments + (list #:make-flags + #~(list (string-append "CC=" (cc-for-target)))))))) (test-equal "compiler-for-target: CC=gcc is acceptable when target=#false" '() (check-compiler-for-target ;; This (dummy) package consists purely of architecture-independent data. (dummy-package "tzdata" - (arguments - (list #:target #false - #:make-flags #~(list "CC=gcc")))))) + (arguments + (list #:target #false + #:make-flags #~(list "CC=gcc")))))) ;; The emacs-build-system sets #:tests? #f by default. (test-equal "tests-true: #:tests? #t acceptable for emacs packages" diff --git a/tests/pack.scm b/tests/pack.scm index f8a9e09c28..1c1e312557 100644 --- a/tests/pack.scm +++ b/tests/pack.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2021, 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; Copyright © 2023 Oleg Pykhalov <go.wigust@gmail.com> +;;; Copyright © 2024 Noé Lopez <noelopez@free.fr> ;;; ;;; This file is part of GNU Guix. ;;; @@ -32,7 +33,8 @@ #:use-module (guix utils) #:use-module ((guix build utils) #:select (%store-directory)) #:use-module (gnu packages) - #:use-module ((gnu packages base) #:select (libc-utf8-locales-for-target)) + #:use-module ((gnu packages base) #:select (libc-utf8-locales-for-target + hello)) #:use-module (gnu packages bootstrap) #:use-module ((gnu packages package-management) #:select (rpm)) #:use-module ((gnu packages compression) #:select (squashfs-tools)) @@ -341,6 +343,42 @@ (built-derivations (list check)))) (unless store (test-skip 1)) + (test-assertm "appimage" + (mlet* %store-monad + ((guile (set-guile-for-build (default-guile))) + (profile -> (profile + (content (packages->manifest (list %bootstrap-guile hello))) + (hooks '()) + (locales? #f))) + (image (self-contained-appimage "hello-appimage" profile + #:entry-point "bin/hello" + #:extra-options + (list #:relocatable? #t))) + (check (gexp->derivation + "check-appimage" + #~(invoke #$image)))) + (built-derivations (list check)))) + + (unless store (test-skip 1)) + (test-assertm "appimage + localstatedir" + (mlet* %store-monad + ((guile (set-guile-for-build (default-guile))) + (profile -> (profile + (content (packages->manifest (list %bootstrap-guile hello))) + (hooks '()) + (locales? #f))) + (image (self-contained-appimage "hello-appimage" profile + #:entry-point "bin/hello" + #:localstatedir? #t + #:extra-options + (list #:relocatable? #t))) + (check (gexp->derivation + "check-appimage" + #~(begin + (invoke #$image))))) + (built-derivations (list check)))) + + (unless store (test-skip 1)) (test-assertm "deb archive with symlinks and control files" (mlet* %store-monad ((guile (set-guile-for-build (default-guile))) diff --git a/tests/packages.scm b/tests/packages.scm index a623628447..1d901505aa 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012-2023 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012-2024 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be> @@ -1628,6 +1628,21 @@ (match (delete-duplicates pythons eq?) ((p) (eq? p python))))) +(test-assert "package-input-rewriting/spec, replace hidden package" + ;; Rewrite hidden packages when requested. + (let* ((python (hidden-package python)) + (p0 (dummy-package "chbouib" + (build-system trivial-build-system) + (inputs (list python)))) + (rewrite (package-input-rewriting/spec + `(("python" . ,(const sed))) + #:replace-hidden? #t)) + (p1 (rewrite p0))) + (match (package-inputs p1) + ((("python" python)) + (and (string=? (package-full-name python) + (package-full-name sed))))))) + (test-equal "package-input-rewriting/spec, graft" (derivation-file-name (package-derivation %store sed)) @@ -2036,6 +2051,14 @@ (dummy-package "a" (arguments (this-package-native-input "hello"))))) +(test-equal "this-package-input, origin" + "http://example.org/foo.tar.gz" + (origin-uri + (package-arguments + (dummy-package "a" + (inputs (list (dummy-origin (uri "http://example.org/foo.tar.gz")))) + (arguments (this-package-input "foo.tar.gz")))))) + (test-eq "modify-inputs, replace" coreutils ;; Replace an input; notice that the label in unchanged. diff --git a/tests/pypi.scm b/tests/pypi.scm index c9aee34d8b..fe00e429b7 100644 --- a/tests/pypi.scm +++ b/tests/pypi.scm @@ -112,6 +112,20 @@ Mock coverage ") +(define test-pyproject.toml "\ +[build-system] +requires = [\"dummy-build-dep-a\", \"dummy-build-dep-b\"] + +[project] +dependencies = [ + \"dummy-dep-a\", + \"dummy-dep-b\", +] + +[project.optional-dependencies] +test = [\"dummy-test-dep-a\", \"dummy-test-dep-b\"] +") + (define test-metadata "\ Classifier: Programming Language :: Python :: 3.7 Requires-Dist: baz ~= 3 @@ -325,13 +339,90 @@ files specified by SPECS. Return its file name." (x (pk 'fail x #f)))))) +(test-assert "pypi->guix-package, no wheel, no requires.txt, but pyproject.toml" + (let ((tarball (pypi-tarball + "foo-1.0.0" + `(("pyproject.toml" ,test-pyproject.toml)))) + (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))))) + ;; 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-dummy-dep-a python-dummy-dep-b)) + (native-inputs (list python-dummy-build-dep-a python-dummy-build-dep-b + python-dummy-test-dep-a python-dummy-test-dep-b)) + (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-assert "pypi->guix-package, no wheel, but requires.txt and pyproject.toml" + (let ((tarball (pypi-tarball + "foo-1.0.0" + `(("foo-1.0.0/pyproject.toml" ,test-pyproject.toml) + ("foo-1.0.0/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))))) + ;; 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) + ;; Information from requires.txt and pyproject.toml is combined. + (propagated-inputs (list python-bar python-dummy-dep-a python-dummy-dep-b + python-foo)) + (native-inputs (list python-dummy-build-dep-a python-dummy-build-dep-b + python-dummy-test-dep-a python-dummy-test-dep-b + 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" +(test-assert "pypi->guix-package, no requires.txt, but wheel." (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")))) + '(("foo-1.0.0/foo.egg-info/.empty" "")))) (wheel (wheel-file "foo-1.0.0" `(("METADATA" ,test-metadata))))) (with-pypi `(("/foo-1.0.0.tar.gz" 200 ,(file-dump tarball)) @@ -362,7 +453,7 @@ to make sure we're testing wheels")))) (x (pk 'fail x #f)))))) -(test-assert "pypi->guix-package, no usable requirement file." +(test-assert "pypi->guix-package, no usable requirement file, no wheel." (let ((tarball (pypi-tarball "foo-1.0.0" '(("foo.egg-info/.empty" ""))))) (with-pypi `(("/foo-1.0.0.tar.gz" 200 ,(file-dump tarball)) diff --git a/tests/toml.scm b/tests/toml.scm new file mode 100644 index 0000000000..cd8e4d2338 --- /dev/null +++ b/tests/toml.scm @@ -0,0 +1,469 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2023 Lars-Dominik Braun <lars@6xq.net> +;;; +;;; 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-toml) + #:use-module (guix build toml) + #:use-module (guix tests) + #:use-module (srfi srfi-19) ; For datetime. + #:use-module (srfi srfi-64) + #:use-module (ice-9 match)) + +(test-begin "toml") + +;; Tests taken from https://toml.io/en/v1.0.0 + +(test-error "parse-toml: Unspecified key" + &file-not-consumed + (parse-toml "key = # INVALID")) + +(test-error "parse-toml: Missing EOL" + &file-not-consumed + (parse-toml "first = \"Tom\" last = \"Preston-Werner\" # INVALID")) + +(test-equal "parse-toml: Bare keys" + '(("key" . "value") ("bare_key" . "value") ("bare-key" . "value") ("1234" . "value")) + (parse-toml "key = \"value\" +bare_key = \"value\" +bare-key = \"value\" +1234 = \"value\"")) + +(test-equal "parse-toml: Quoted keys" + '(("127.0.0.1" . "value") + ("character encoding" . "value") + ("ʎǝʞ" . "value") + ("key2" . "value") + ("quoted \"value\"" . "value")) + (parse-toml "\"127.0.0.1\" = \"value\" +\"character encoding\" = \"value\" +\"ʎǝʞ\" = \"value\" +'key2' = \"value\" +'quoted \"value\"' = \"value\"")) + +(test-equal "parse-toml: No key" + #f + (parse-toml "= \"no key name\"")) + +(test-equal "parse-toml: Empty key" + '(("" . "blank")) + (parse-toml "\"\" = \"blank\"")) + +(test-equal "parse-toml: Dotted keys" + '(("name" . "Orange") + ("physical" ("color" . "orange") + ("shape" . "round")) + ("site" ("google.com" . #t))) + (parse-toml "name = \"Orange\" +physical.color = \"orange\" +physical.shape = \"round\" +site.\"google.com\" = true")) + +(test-equal "parse-toml: Dotted keys with whitespace" + '(("fruit" ("name" . "banana") ("color" . "yellow") ("flavor" . "banana"))) + (parse-toml "fruit.name = \"banana\" # this is best practice +fruit. color = \"yellow\" # same as fruit.color +fruit . flavor = \"banana\" # same as fruit.flavor")) + +(test-error "parse-toml: Multiple keys" + &already-defined + (parse-toml "name = \"Tom\" +name = \"Pradyun\"")) + +(test-equal "parse-toml: Implicit tables" + '(("fruit" ("apple" ("smooth" . #t)) ("orange" . 2))) + (parse-toml "fruit.apple.smooth = true +fruit.orange = 2")) + +(test-error "parse-toml: Write to value" + &already-defined + (parse-toml "fruit.apple = 1 +fruit.apple.smooth = true")) + +(test-equal "parse-toml: String" + '(("str" . "I'm a string. \"You can quote me\". Name\tJos\u00E9\nLocation\tSF.")) + (parse-toml "str = \"I'm a string. \\\"You can quote me\\\". Name\\tJos\\u00E9\\nLocation\\tSF.\"")) + +(test-equal "parse-toml: Empty string" + '(("str1" . "") + ("str2" . "") + ("str3" . "") + ("str4" . "")) + (parse-toml "str1 = \"\" +str2 = '' +str3 = \"\"\"\"\"\" +str4 = ''''''")) + +(test-equal "parse-toml: Multi-line basic strings" + '(("str1" . "Roses are red\nViolets are blue") + ("str2" . "The quick brown fox jumps over the lazy dog.") + ("str3" . "The quick brown fox jumps over the lazy dog.") + ("str4" . "Here are two quotation marks: \"\". Simple enough.") + ("str5" . "Here are three quotation marks: \"\"\".") + ("str6" . "Here are fifteen quotation marks: \"\"\"\"\"\"\"\"\"\"\"\"\"\"\".") + ("str7" . "\"This,\" she said, \"is just a pointless statement.\"")) + (parse-toml "str1 = \"\"\" +Roses are red +Violets are blue\"\"\" + +str2 = \"\"\" +The quick brown \\ + + + fox jumps over \\ + the lazy dog.\"\"\" + +str3 = \"\"\"\\ + The quick brown \\ + fox jumps over \\ + the lazy dog.\\ + \"\"\" + +str4 = \"\"\"Here are two quotation marks: \"\". Simple enough.\"\"\" +# str5 = \"\"\"Here are three quotation marks: \"\"\".\"\"\" # INVALID +str5 = \"\"\"Here are three quotation marks: \"\"\\\".\"\"\" +str6 = \"\"\"Here are fifteen quotation marks: \"\"\\\"\"\"\\\"\"\"\\\"\"\"\\\"\"\"\\\".\"\"\" + +# \"This,\" she said, \"is just a pointless statement.\" +str7 = \"\"\"\"This,\" she said, \"is just a pointless statement.\"\"\"\"")) + +(test-equal "parse-toml: Literal string" + '(("winpath" . "C:\\Users\\nodejs\\templates") + ("winpath2" . "\\\\ServerX\\admin$\\system32\\") + ("quoted" . "Tom \"Dubs\" Preston-Werner") + ("regex" . "<\\i\\c*\\s*>")) + (parse-toml "winpath = 'C:\\Users\\nodejs\\templates' +winpath2 = '\\\\ServerX\\admin$\\system32\\' +quoted = 'Tom \"Dubs\" Preston-Werner' +regex = '<\\i\\c*\\s*>'")) + +(test-equal "parse-toml: Multi-line literal strings" + '(("regex2" . "I [dw]on't need \\d{2} apples") + ("lines" . "The first newline is\ntrimmed in raw strings.\n All other whitespace\n is preserved.\n") + ("quot15" . "Here are fifteen quotation marks: \"\"\"\"\"\"\"\"\"\"\"\"\"\"\"") + ("apos15" . "Here are fifteen apostrophes: '''''''''''''''") + ("str" . "'That,' she said, 'is still pointless.'")) + (parse-toml "regex2 = '''I [dw]on't need \\d{2} apples''' +lines = ''' +The first newline is +trimmed in raw strings. + All other whitespace + is preserved. +''' +quot15 = '''Here are fifteen quotation marks: \"\"\"\"\"\"\"\"\"\"\"\"\"\"\"''' + +# apos15 = '''Here are fifteen apostrophes: '''''''''''''''''' # INVALID +apos15 = \"Here are fifteen apostrophes: '''''''''''''''\" + +# 'That,' she said, 'is still pointless.' +str = ''''That,' she said, 'is still pointless.''''")) + +(test-equal "parse-toml: Decimal integer" + '(("int1" . 99) ("int2" . 42) ("int3" . 0) ("int4" . -17)) + (parse-toml "int1 = +99 +int2 = 42 +int3 = 0 +int4 = -17")) + +(test-equal "parse-toml: Decimal integer underscores" + '(("int5" . 1000) ("int6" . 5349221) ("int7" . 5349221) ("int8" . 12345)) + (parse-toml "int5 = 1_000 +int6 = 5_349_221 +int7 = 53_49_221 # Indian number system grouping +int8 = 1_2_3_4_5 # VALID but discouraged")) + +(test-equal "parse-toml: Hexadecimal" + `(("hex1" . ,#xdeadbeef) ("hex2" . ,#xdeadbeef) ("hex3" . ,#xdeadbeef)) + (parse-toml "hex1 = 0xDEADBEEF +hex2 = 0xdeadbeef +hex3 = 0xdead_beef")) + +(test-equal "parse-toml: Octal" + `(("oct1" . ,#o01234567) ("oct2" . #o755)) + (parse-toml "oct1 = 0o01234567 +oct2 = 0o755")) + +(test-equal "parse-toml: Binary" + `(("bin1" . ,#b11010110)) + (parse-toml "bin1 = 0b11010110")) + +(test-equal "parse-toml: Float" + '(("flt1" . 1.0) + ("flt2" . 3.1415) + ("flt3" . -0.01) + ("flt4" . 5e+22) + ("flt5" . 1e06) + ("flt6" . -2e-2) + ("flt7" . 6.626e-34) + ("flt8" . 224617.445991228)) + (parse-toml "# fractional +flt1 = +1.0 +flt2 = 3.1415 +flt3 = -0.01 + +# exponent +flt4 = 5e+22 +flt5 = 1e06 +flt6 = -2E-2 + +# both +flt7 = 6.626e-34 + +flt8 = 224_617.445_991_228")) + +(test-equal "parse-toml: Float" + '(("sf1" . +inf.0) + ("sf2" . +inf.0) + ("sf3" . -inf.0) + ("sf4" . +nan.0) + ("sf5" . +nan.0) + ("sf6" . -nan.0)) + (parse-toml "# infinity +sf1 = inf # positive infinity +sf2 = +inf # positive infinity +sf3 = -inf # negative infinity + +# not a number +sf4 = nan # actual sNaN/qNaN encoding is implementation-specific +sf5 = +nan # same as `nan` +sf6 = -nan # valid, actual encoding is implementation-specific")) + +(test-equal "parse-toml: Boolean" + '(("bool1" . #t) + ("bool2" . #f)) + (parse-toml "bool1 = true +bool2 = false")) + +(test-equal "parse-toml: Offset date-time" + `(("odt1" . ,(make-date #f 0 32 7 27 5 1979 0)) + ("odt2" . ,(make-date #f 0 32 0 27 5 1979 (* -7 60 60))) + ("odt3" . ,(make-date 999999 0 32 0 27 5 1979 (* 7 60 60))) + ("odt4" . ,(make-date #f 0 32 7 27 5 1979 0))) + (parse-toml "odt1 = 1979-05-27T07:32:00Z +odt2 = 1979-05-27T00:32:00-07:00 +odt3 = 1979-05-27T00:32:00.999999+07:00 +odt4 = 1979-05-27 07:32:00Z")) + +(test-equal "parse-toml: Local date-time" + `(("ldt1" . ,(make-date #f 0 32 7 27 5 1979 #f)) + ("ldt2" . ,(make-date 999999 0 32 0 27 5 1979 #f))) + (parse-toml "ldt1 = 1979-05-27T07:32:00 +ldt2 = 1979-05-27T00:32:00.999999")) + +(test-equal "parse-toml: Local date" + `(("ld1" . ,(make-date #f #f #f #f 27 5 1979 #f))) + (parse-toml "ld1 = 1979-05-27")) + +(test-equal "parse-toml: Local time" + `(("lt1" . ,(make-date #f 0 32 7 #f #f #f #f)) + ("lt2" . ,(make-date 999999 0 32 0 #f #f #f #f))) + (parse-toml "lt1 = 07:32:00 +lt2 = 00:32:00.999999")) + +(test-equal "parse-toml: Arrays" + '(("integers" 1 2 3) + ("colors" "red" "yellow" "green") + ("nested_arrays_of_ints" (1 2) (3 4 5)) + ("nested_mixed_array" (1 2) ("a" "b" "c")) + ("string_array" "all" "strings") + ("numbers" 0.1 0.2 0.5 1 2 5) + ("contributors" "Foo Bar <foo@example.com>" (("name" . "Baz Qux") ("email" . "bazqux@example.com") ("url" . "https://example.com/bazqux"))) + ("integers2" 1 2 3) + ("integers3" 1 2)) + (parse-toml "integers = [ 1, 2, 3 ] +colors = [ \"red\", \"yellow\", \"green\" ] +nested_arrays_of_ints = [ [ 1, 2 ], [3, 4, 5] ] +nested_mixed_array = [ [ 1, 2 ], [\"a\", \"b\", \"c\"] ] +string_array = [ \"all\", 'strings' ] + +# Mixed-type arrays are allowed +numbers = [ 0.1, 0.2, 0.5, 1, 2, 5 ] +contributors = [ + \"Foo Bar <foo@example.com>\", + { name = \"Baz Qux\", email = \"bazqux@example.com\", url = \"https://example.com/bazqux\" } +] + +integers2 = [ + 1, 2, 3 +] + +integers3 = [ + 1, + 2, # this is ok +]")) + +(test-equal "parse-toml: Arrays of empty strings" + '(("empty1" "") + ("empty2" "" "") + ("empty3" "" "" "") + ("emptyraw1" "") + ("emptyraw2" "" "") + ("emptyraw3" "" "" "") + ("emptyml1" "") + ("emptyml2" "" "") + ("emptyml3" "" "" "") + ("emptyrawml1" "") + ("emptyrawml2" "" "") + ("emptyrawml3" "" "" "")) + (parse-toml "empty1 = [ \"\" ] +empty2 = [ \"\", \"\" ] +empty3 = [ \"\", \"\", \"\" ] +emptyraw1 = [ '' ] +emptyraw2 = [ '', '' ] +emptyraw3 = [ '', '', '' ] +emptyml1 = [ \"\"\"\"\"\" ] +emptyml2 = [ \"\"\"\"\"\", \"\"\"\"\"\" ] +emptyml3 = [ \"\"\"\"\"\", \"\"\"\"\"\", \"\"\"\"\"\" ] +emptyrawml1 = [ '''''' ] +emptyrawml2 = [ '''''', '''''' ] +emptyrawml3 = [ '''''', '''''', '''''' ] +")) + +(test-equal "parse-toml: Tables" + '(("table-1" ("key1" . "some string") + ("key2" . 123)) + ("table-2" ("key1" . "another string") + ("key2" . 456))) + (parse-toml "[table-1] +key1 = \"some string\" +key2 = 123 + +[table-2] +key1 = \"another string\" +key2 = 456")) + + +(test-equal "parse-toml: Dotted table" + '(("dog" ("tater.man" ("type" ("name" . "pug"))))) + (parse-toml "[dog.\"tater.man\"] +type.name = \"pug\"")) + + +(test-equal "parse-toml: Dotted table with whitespace" + '(("a" ("b" ("c" ("x" . 1)))) + ("d" ("e" ("f" ("x" . 1)))) + ("g" ("h" ("i" ("x" . 1)))) + ("j" ("ʞ" ("l" ("x" . 1))))) + (parse-toml "[a.b.c] # this is best practice +x=1 +[ d.e.f ] # same as [d.e.f] +x=1 +[ g . h . i ] # same as [g.h.i] +x=1 +[ j . \"ʞ\" . 'l' ] # same as [j.\"ʞ\".'l'] +x=1")) + +;; XXX: technically this is not allowed, but we permit it. +(test-equal "parse-toml: Multiple tables" + '(("fruit" ("apple" . "red") ("orange" . "orange"))) + (parse-toml "[fruit] +apple = \"red\" + +[fruit] +orange = \"orange\"")) + +(test-equal "parse-toml: Assignment to non-table" + #f + (parse-toml "[fruit] +apple = \"red\" + +[fruit.apple] +texture = \"smooth\"")) + +(test-equal "parse-toml: Dotted keys create tables" + '(("fruit" ("apple" ("color" . "red") ("taste" ("sweet" . #t))))) + (parse-toml "fruit.apple.color = \"red\" +fruit.apple.taste.sweet = true")) + +(test-equal "parse-toml: Inline tables" + '(("name" ("first" . "Tom") ("last" . "Preston-Werner")) + ("point" ("x" . 1) ("y" . 2)) + ("animal" ("type" ("name" . "pug")))) + (parse-toml "name = { first = \"Tom\", last = \"Preston-Werner\" } +point = { x = 1, y = 2 } +animal = { type.name = \"pug\" }")) + +(test-error "parse-toml: Invalid assignment to inline table" + #t + (parse-toml "[product] +type = { name = \"Nail\" } +type.edible = false # INVALID")) + +;; We do not catch this semantic error yet. +(test-expect-fail 1) +(test-error "parse-toml: Invalid assignment to implicit table" + #f + (parse-toml "[product] +type.name = \"Nail\" +type = { edible = false } # INVALID")) + +;; Not implemented. +(test-expect-fail 1) +(test-equal "parse-toml: Array of tables" + '(("products" (("name" . "Hammer") ("sku" . 738594937)) + () + (("name" . "Nail") ("sku" . 284758393) ("color" . "gray")))) + (parse-toml "[[products]] +name = \"Hammer\" +sku = 738594937 + +[[products]] # empty table within the array + +[[products]] +name = \"Nail\" +sku = 284758393 + +color = \"gray\"")) + +;; Not implemented. +(test-expect-fail 1) +(test-equal "parse-toml: Array of tables" + '(("fruits" ((("name" . "apple") + ("physical" (("color" . "red") ("shape" . "round"))) + ("varieties" ((("name" . "red delicious")) (("name" . "granny smith"))))) + (("name" . "banana") + ("varieties" (((("name" . "plantain"))))))))) + (parse-toml "[[fruits]] +name = \"apple\" + +[fruits.physical] # subtable +color = \"red\" +shape = \"round\" + +[[fruits.varieties]] # nested array of tables +name = \"red delicious\" + +[[fruits.varieties]] +name = \"granny smith\" + + +[[fruits]] +name = \"banana\" + +[[fruits.varieties]] +name = \"plantain\"")) + +;; Not implemented. +(test-expect-fail 1) +(test-error "parse-toml: Assignment to statically defined array" + #f + (parse-toml "fruits = [] + +[[fruits]] +x=1")) + +(test-end "toml") + diff --git a/tests/transformations.scm b/tests/transformations.scm index 755211d65d..5285d98f17 100644 --- a/tests/transformations.scm +++ b/tests/transformations.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016-2017, 2019-2023 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2016-2017, 2019-2024 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2021 Marius Bakke <marius@gnu.org> ;;; ;;; This file is part of GNU Guix. @@ -497,6 +497,35 @@ (let ((new (t coreutils))) (assq-ref (package-properties new) 'transformations)))) +(test-equal "package-with-upstream-version" + '("42.0" "42.0" + ("http://example.org") + ("a" "b") (do something)) + (mock ((guix upstream) %updaters + (delay (list (upstream-updater + (name 'dummy) + (pred (const #t)) + (description "") + (import (const (upstream-source + (package "foo") + (version "42.0") + (urls '("http://example.org"))))))))) + (let* ((old (dummy-package "foo" (version "1.0") + (source (dummy-origin + (patches '("a" "b")) + (snippet '(do something)))))) + (new (package-with-upstream-version old)) + (new+patches (package-with-upstream-version + old #:preserve-patches? #t))) + (list (package-version new) (package-version new+patches) + + ;; Source of NEW is directly an <upstream-source>. + (upstream-source-urls (package-source new)) + + ;; Check that #:preserve-patches? #t gave us an origin. + (origin-patches (package-source new+patches)) + (origin-snippet (package-source new+patches)))))) + (test-equal "options->transformation, with-latest" "42.0" (mock ((guix upstream) %updaters |