aboutsummaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/cache.scm15
-rw-r--r--tests/crate.scm4
-rw-r--r--tests/elm.scm268
-rw-r--r--tests/gexp.scm30
-rw-r--r--tests/guix-home.sh2
-rw-r--r--tests/guix-pack.sh2
-rw-r--r--tests/guix-package.sh30
-rw-r--r--tests/guix-shell-export-manifest.sh90
-rw-r--r--tests/hackage.scm215
-rw-r--r--tests/home-import.scm13
-rw-r--r--tests/home-services.scm46
-rw-r--r--tests/inferior.scm16
-rw-r--r--tests/keys/ed25519-2.pub11
-rw-r--r--tests/keys/ed25519-3.pub10
-rw-r--r--tests/keys/ed25519.pub10
-rw-r--r--tests/lint.scm11
-rw-r--r--tests/packages.scm13
-rw-r--r--tests/profiles.scm2
-rw-r--r--tests/publish.scm23
-rw-r--r--tests/services.scm75
-rw-r--r--tests/style.scm9
-rw-r--r--tests/transformations.scm14
22 files changed, 841 insertions, 68 deletions
diff --git a/tests/cache.scm b/tests/cache.scm
index 80b44d69aa..d495ace2bd 100644
--- a/tests/cache.scm
+++ b/tests/cache.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2022 Simon Tournier <zimon.toutoune@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -74,6 +75,20 @@
(lambda (port)
(display 0 port)))))
+(test-equal "maybe-remove-expired-cache-entries, empty cache"
+ '("a" "b" "c")
+ (test-cache-cleanup cache
+ (call-with-output-file (string-append cache "/last-expiry-cleanup")
+ (lambda (port)
+ (display "" port)))))
+
+(test-equal "maybe-remove-expired-cache-entries, corrupted cache"
+ '("a" "b" "c")
+ (test-cache-cleanup cache
+ (call-with-output-file (string-append cache "/last-expiry-cleanup")
+ (lambda (port)
+ (display "1\"34657890" port)))))
+
(test-end "cache")
;;; Local Variables:
diff --git a/tests/crate.scm b/tests/crate.scm
index b6c3a7ee2e..720fcb212c 100644
--- a/tests/crate.scm
+++ b/tests/crate.scm
@@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 David Thompson <davet@gnu.org>
;;; Copyright © 2016 David Craven <david@craven.ch>
-;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
;;;
;;; This file is part of GNU Guix.
@@ -572,7 +572,7 @@
(string->license "Apache-2.0 WITH LLVM-exception"))
(test-equal "licenses: MIT/Apache-2.0 AND BSD-2-Clause"
- '(license:expat license:asl2.0 unknown-license!)
+ '(license:expat license:asl2.0 license:bsd-2)
(string->license "MIT/Apache-2.0 AND BSD-2-Clause"))
(test-equal "licenses: MIT/Apache-2.0"
diff --git a/tests/elm.scm b/tests/elm.scm
new file mode 100644
index 0000000000..c30623da03
--- /dev/null
+++ b/tests/elm.scm
@@ -0,0 +1,268 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2022 Philip McGrath <philip@philipmcgrath.com>
+;;;
+;;; 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-elm)
+ #:use-module (guix build-system elm)
+ #:use-module (guix import elm)
+ #:use-module (guix base32)
+ #:use-module (guix hash)
+ #:use-module (guix utils)
+ #:autoload (gcrypt hash) (hash-algorithm sha256)
+ #:use-module (json)
+ #:use-module (ice-9 match)
+ #:use-module (srfi srfi-64))
+
+(test-begin "elm")
+
+(test-group "elm->package-name and infer-elm-package-name"
+ (test-group "round trip"
+ ;; Cases when our heuristics can find the upstream name.
+ (define-syntax-rule (test-round-trip elm guix)
+ (test-group elm
+ (test-equal "elm->package-name" guix
+ (elm->package-name elm))
+ (test-equal "infer-elm-package-name" elm
+ (infer-elm-package-name guix))))
+ (test-round-trip "elm/core" "elm-core")
+ (test-round-trip "elm/html" "elm-html")
+ (test-round-trip "elm-explorations/markdown" "elm-explorations-markdown")
+ (test-round-trip "elm-explorations/test" "elm-explorations-test")
+ (test-round-trip "elm-explorations/foo-bar" "elm-explorations-foo-bar")
+ (test-round-trip "elm/explorations" "elm-explorations")
+ (test-round-trip "terezka/intervals" "elm-terezka-intervals")
+ (test-round-trip "justinmimbs/time-extra" "elm-justinmimbs-time-extra")
+ (test-round-trip "danhandrea/elm-date-format"
+ "elm-danhandrea-elm-date-format"))
+ (test-group "upstream-name needed"
+ ;; Upstream names that our heuristic can't infer. We still check that the
+ ;; round-trip behavior of 'infer-elm-package-name' works as promised for
+ ;; the hypothetical Elm name it doesn't infer.
+ (define-syntax-rule (test-upstream-needed elm guix inferred)
+ (test-group elm
+ (test-equal "elm->package-name" guix
+ (elm->package-name elm))
+ (test-group "infer-elm-package-name"
+ (test-equal "infers other name" inferred
+ (infer-elm-package-name guix))
+ (test-equal "infered name round-trips" guix
+ (elm->package-name inferred)))))
+ (test-upstream-needed "elm/virtual-dom"
+ "elm-virtual-dom"
+ "virtual/dom")
+ (test-upstream-needed "elm/project-metadata-utils"
+ "elm-project-metadata-utils"
+ "project/metadata-utils")
+ (test-upstream-needed "explorations/foo"
+ "elm-explorations-foo"
+ "elm-explorations/foo")
+ (test-upstream-needed "explorations/foo-bar"
+ "elm-explorations-foo-bar"
+ "elm-explorations/foo-bar")
+ (test-upstream-needed "explorations-central/foo"
+ "elm-explorations-central-foo"
+ "elm-explorations/central-foo")
+ (test-upstream-needed "explorations-central/foo-bar"
+ "elm-explorations-central-foo-bar"
+ "elm-explorations/central-foo-bar")
+ (test-upstream-needed "elm-xyz/foo"
+ "elm-xyz-foo"
+ "xyz/foo")
+ (test-upstream-needed "elm-xyz/foo-bar"
+ "elm-xyz-foo-bar"
+ "xyz/foo-bar")
+ (test-upstream-needed "elm-explorations-xyz/foo"
+ "elm-explorations-xyz-foo"
+ "elm-explorations/xyz-foo")
+ (test-upstream-needed "elm-explorations-xyz/foo-bar"
+ "elm-explorations-xyz-foo-bar"
+ "elm-explorations/xyz-foo-bar"))
+ (test-group "no inferred Elm name"
+ ;; Cases that 'infer-elm-package-name' should not attempt to handle,
+ ;; because 'elm->package-name' would never produce such names.
+ (define-syntax-rule (test-not-inferred guix)
+ (test-assert guix (not (infer-elm-package-name guix))))
+ (test-not-inferred "elm")
+ (test-not-inferred "guile")
+ (test-not-inferred "gcc-toolchain")
+ (test-not-inferred "font-adobe-source-sans-pro")))
+
+(define test-package-registry-json
+ ;; we intentionally list versions in different orders here
+ "{
+ \"elm/core\": [\"1.0.0\", \"1.0.1\", \"1.0.2\", \"1.0.3\", \"1.0.4\"],
+ \"elm-guix/demo\": [\"2.0.0\", \"3.0.0\", \"1.0.0\"]
+}")
+
+(define test-elm-core-json
+ "{
+ \"type\": \"package\",
+ \"name\": \"elm/core\",
+ \"summary\": \"Elm's standard libraries\",
+ \"license\": \"BSD-3-Clause\",
+ \"version\": \"1.0.4\",
+ \"exposed-modules\": {
+ \"Primitives\": [
+ \"Basics\",
+ \"String\",
+ \"Char\",
+ \"Bitwise\",
+ \"Tuple\"
+ ],
+ \"Collections\": [
+ \"List\",
+ \"Dict\",
+ \"Set\",
+ \"Array\"
+ ],
+ \"Error Handling\": [
+ \"Maybe\",
+ \"Result\"
+ ],
+ \"Debug\": [
+ \"Debug\"
+ ],
+ \"Effects\": [
+ \"Platform.Cmd\",
+ \"Platform.Sub\",
+ \"Platform\",
+ \"Process\",
+ \"Task\"
+ ]
+ },
+ \"elm-version\": \"0.19.0 <= v < 0.20.0\",
+ \"dependencies\": {},
+ \"test-dependencies\": {}
+}")
+
+(define test-elm-core-readme
+ "# Core Libraries
+
+Every Elm project needs this package!
+
+It provides **basic functionality** like addition and subtraction as well as
+**data structures** like lists, dictionaries, and sets.")
+
+(define test-elm-guix-demo-json
+ "{
+ \"type\": \"package\",
+ \"name\": \"elm-guix/demo\",
+ \"summary\": \"A test for `(guix import elm)`\",
+ \"license\": \"GPL-3.0-or-later\",
+ \"version\": \"3.0.0\",
+ \"exposed-modules\": [
+ \"Guix.Demo\"
+ ],
+ \"elm-version\": \"0.19.0 <= v < 0.20.0\",
+ \"dependencies\": {
+ \"elm/core\": \"1.0.0 <= v < 2.0.0\"
+ },
+ \"test-dependencies\": {
+ \"elm/json\": \"1.0.0 <= v < 2.0.0\"
+ }
+}")
+
+(define test-elm-guix-demo-readme
+ ;; intentionally left blank
+ "")
+
+(define (directory-sha256 directory)
+ "Returns the string representing the hash of DIRECTORY as would be used in a
+package definition."
+ (bytevector->nix-base32-string
+ (file-hash* directory
+ #:algorithm (hash-algorithm sha256)
+ #:recursive? #t)))
+
+(test-group "(guix import elm)"
+ (call-with-temporary-directory
+ (lambda (dir)
+ ;; Initialize our fake git checkouts.
+ (define elm-core-dir
+ (string-append dir "/test-elm-core-1.0.4"))
+ (define elm-guix-demo-dir
+ (string-append dir "/test-elm-guix-demo-3.0.0"))
+ (for-each (match-lambda
+ ((dir json readme)
+ (mkdir dir)
+ (with-output-to-file (string-append dir "/elm.json")
+ (lambda ()
+ (display json)))
+ (with-output-to-file (string-append dir "/README.md")
+ (lambda ()
+ (display readme)))))
+ `((,elm-core-dir ,test-elm-core-json ,test-elm-core-readme)
+ (,elm-guix-demo-dir
+ ,test-elm-guix-demo-json
+ ,test-elm-guix-demo-readme)))
+ ;; Replace network resources with sample data.
+ (parameterize ((%elm-package-registry
+ (lambda ()
+ (json-string->scm test-package-registry-json)))
+ (%current-elm-checkout
+ (lambda (name version)
+ (match (list name version)
+ (("elm/core" "1.0.4")
+ elm-core-dir)
+ (("elm-guix/demo" "3.0.0")
+ elm-guix-demo-dir)))))
+ (test-assert "(elm->guix-package \"elm/core\")"
+ (match (elm->guix-package "elm/core")
+ (`(package
+ (name "elm-core")
+ (version "1.0.4")
+ (source (elm-package-origin
+ "elm/core"
+ version
+ (base32 ,(? string? hash))))
+ (build-system elm-build-system)
+ (home-page
+ "https://package.elm-lang.org/packages/elm/core/1.0.4")
+ (synopsis "Elm's standard libraries")
+ (description "Every Elm project needs this package!")
+ (license license:bsd-3))
+ (equal? (directory-sha256 elm-core-dir)
+ hash))
+ (x
+ (raise-exception x))))
+ (test-assert "(elm-recursive-import \"elm-guix/demo\")"
+ (match (elm-recursive-import "elm-guix/demo")
+ (`((package
+ (name "elm-guix-demo")
+ (version "3.0.0")
+ (source (elm-package-origin
+ "elm-guix/demo"
+ version
+ (base32 ,(? string? hash))))
+ (build-system elm-build-system)
+ (propagated-inputs
+ ,'`(("elm-core" ,elm-core)))
+ (inputs
+ ,'`(("elm-json" ,elm-json)))
+ (home-page
+ "https://package.elm-lang.org/packages/elm-guix/demo/3.0.0")
+ (synopsis "A test for `(guix import elm)`")
+ (description
+ "This package provides a test for `(guix import elm)`")
+ (properties '((upstream-name . "elm-guix/demo")))
+ (license license:gpl3+)))
+ (equal? (directory-sha256 elm-guix-demo-dir)
+ hash))
+ (x
+ (raise-exception x))))))))
+
+(test-end "elm")
diff --git a/tests/gexp.scm b/tests/gexp.scm
index c80ca13fab..07e940ffdc 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -502,7 +502,7 @@
(ungexp coreutils)
(ungexp-native glibc)
(ungexp binutils))))
- (target "mips64el-linux")
+ (target "mips64el-linux-gnu")
(guile (derivation->output-path
(package-derivation %store %bootstrap-guile)))
(cu (derivation->output-path
@@ -547,7 +547,7 @@
(gexp->sexp* exp)))))
(test-assert "input list + ungexp-native"
- (let* ((target "mips64el-linux")
+ (let* ((target "mips64el-linux-gnu")
(exp (gexp (display
(cons '(ungexp-native (list %bootstrap-guile coreutils))
'(ungexp (list glibc binutils))))))
@@ -764,7 +764,7 @@
intd)))))
(test-assertm "gexp->derivation, cross-compilation"
- (mlet* %store-monad ((target -> "mips64el-linux")
+ (mlet* %store-monad ((target -> "mips64el-linux-gnu")
(exp -> (gexp (list (ungexp coreutils)
(ungexp output))))
(xdrv (gexp->derivation "foo" exp
@@ -778,7 +778,7 @@
(not (member (derivation-file-name cu) refs))))))
(test-assertm "gexp->derivation, ungexp-native"
- (mlet* %store-monad ((target -> "mips64el-linux")
+ (mlet* %store-monad ((target -> "mips64el-linux-gnu")
(exp -> (gexp (list (ungexp-native coreutils)
(ungexp output))))
(xdrv (gexp->derivation "foo" exp
@@ -788,7 +788,7 @@
(derivation-file-name xdrv)))))
(test-assertm "gexp->derivation, ungexp + ungexp-native"
- (mlet* %store-monad ((target -> "mips64el-linux")
+ (mlet* %store-monad ((target -> "mips64el-linux-gnu")
(exp -> (gexp (list (ungexp-native coreutils)
(ungexp glibc)
(ungexp output))))
@@ -802,7 +802,7 @@
(member (derivation-file-name xglibc) refs)))))
(test-assertm "gexp->derivation, ungexp-native + composed gexps"
- (mlet* %store-monad ((target -> "mips64el-linux")
+ (mlet* %store-monad ((target -> "mips64el-linux-gnu")
(exp0 -> (gexp (list 1 2
(ungexp coreutils))))
(exp -> (gexp (list 0 (ungexp-native exp0))))
@@ -1606,6 +1606,24 @@ importing.* \\(guix config\\) from the host"
(not (member (derivation-file-name native) refs))
(member (derivation-file-name cross) refs))))))
+(test-assertm "references-file"
+ (let* ((exp #~(symlink #$%bootstrap-guile #$output))
+ (computed (computed-file "computed" exp
+ #:guile %bootstrap-guile))
+ (refs (references-file computed "refs"
+ #:guile %bootstrap-guile)))
+ (mlet* %store-monad ((drv0 (lower-object %bootstrap-guile))
+ (drv1 (lower-object computed))
+ (drv2 (lower-object refs)))
+ (mbegin %store-monad
+ (built-derivations (list drv2))
+ (mlet %store-monad ((refs ((store-lift requisites)
+ (list (derivation->output-path drv1)))))
+ (return (lset= string=?
+ (call-with-input-file (derivation->output-path drv2)
+ read)
+ refs)))))))
+
(test-assert "lower-object & gexp-input-error?"
(guard (c ((gexp-input-error? c)
(gexp-error-invalid-input c)))
diff --git a/tests/guix-home.sh b/tests/guix-home.sh
index 0f68484ef4..8a7048a9ca 100644
--- a/tests/guix-home.sh
+++ b/tests/guix-home.sh
@@ -69,7 +69,7 @@ trap 'chmod -Rf +w "$test_directory"; rm -rf "$test_directory"' EXIT
(list
(simple-service 'test-config
home-files-service-type
- (list `("config/test.conf"
+ (list `(".config/test.conf"
,(plain-file
"tmp-file.txt"
"the content of ~/.config/test.conf"))))
diff --git a/tests/guix-pack.sh b/tests/guix-pack.sh
index 1356a74083..f19a0f754e 100644
--- a/tests/guix-pack.sh
+++ b/tests/guix-pack.sh
@@ -107,7 +107,7 @@ guix pack --dry-run --bootstrap -f docker -S /opt/gnu=/ guile-bootstrap
# Build a tarball pack of cross-compiled software. Use coreutils because
# guile-bootstrap is not intended to be cross-compiled.
-guix pack --dry-run --bootstrap --target=arm-unknown-linux-gnueabihf coreutils
+guix pack --dry-run --bootstrap --target=arm-linux-gnueabihf coreutils
# Likewise, 'guix pack -R' requires a full-blown toolchain (because
# 'glibc-bootstrap' lacks 'libc.a'), hence '--dry-run'.
diff --git a/tests/guix-package.sh b/tests/guix-package.sh
index d1b383d2ad..dedba2fd74 100644
--- a/tests/guix-package.sh
+++ b/tests/guix-package.sh
@@ -1,6 +1,7 @@
# GNU Guix --- Functional package management for GNU
# Copyright © 2012-2022 Ludovic Courtès <ludo@gnu.org>
# Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
+# Copyright © 2022 Josselin Poiret <dev@jpoiret.xyz>
#
# This file is part of GNU Guix.
#
@@ -210,6 +211,35 @@ test "$(readlink -f "$profile/bin/guile")" \
test ! -f "$profile/bin/sed"
rm "$profile" "$profile"-[0-9]-link
+# Make sure transformations apply to propagated inputs and don't lead to
+# conflicts when installing them alongside, see
+# <https://issues.guix.gnu.org/55316>.
+mkdir "$module_dir"
+cat > "$module_dir/test.scm" <<EOF
+(define-module (test)
+ #:use-module (guix packages)
+ #:use-module (gnu packages base)
+ #:use-module (guix build-system trivial))
+
+(define-public dummy-package
+ (package
+ (name "dummy-package")
+ (version "1")
+ (source #f)
+ (build-system trivial-build-system)
+ (propagated-inputs
+ (list hello))
+ (synopsis "dummy")
+ (description "dummy")
+ (home-page "dummy")
+ (license #f)))
+EOF
+guix package -p "$profile" -L "$module_dir"\
+ -i hello dummy-package \
+ --without-tests=hello -n
+rm "$module_dir/test.scm"
+rmdir "$module_dir"
+
# Profiles with a relative file name. Make sure we don't create dangling
# symlinks--see bug report at
# <https://lists.gnu.org/archive/html/guix-devel/2018-07/msg00036.html>.
diff --git a/tests/guix-shell-export-manifest.sh b/tests/guix-shell-export-manifest.sh
new file mode 100644
index 0000000000..05429955b9
--- /dev/null
+++ b/tests/guix-shell-export-manifest.sh
@@ -0,0 +1,90 @@
+# GNU Guix --- Functional package management for GNU
+# Copyright © 2022 Ludovic Courtès <ludo@gnu.org>
+#
+# 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/>.
+
+#
+# Test 'guix shell --export-manifest'.
+#
+
+guix shell --version
+
+tmpdir="t-guix-manifest-$$"
+trap 'rm -r "$tmpdir"' EXIT
+mkdir "$tmpdir"
+
+manifest="$tmpdir/manifest.scm"
+
+# Basics.
+guix shell --export-manifest guile-bootstrap > "$manifest"
+test "$(guix build -m "$manifest")" = "$(guix build guile-bootstrap)"
+
+guix shell -m "$manifest" --bootstrap -- \
+ "$SHELL" -c 'guix package --export-manifest -p "$GUIX_ENVIRONMENT"' > \
+ "$manifest.second"
+for m in "$manifest" "$manifest.second"
+do
+ grep -v '^;' < "$m" > "$m.new" # filter out comments
+ mv "$m.new" "$m"
+done
+
+cat "$manifest"
+cat "$manifest.second"
+
+cmp "$manifest" "$manifest.second"
+
+# Combining manifests.
+guix shell --export-manifest -m "$manifest" gash gash-utils \
+ > "$manifest.second"
+guix build -m "$manifest.second" -d | \
+ grep "$(guix build guile-bootstrap -d)"
+guix build -m "$manifest.second" -d | \
+ grep "$(guix build gash -d)"
+
+# Package transformation option.
+guix shell --export-manifest guile guix \
+ --with-input=guile-json@3=guile-json > "$manifest"
+grep 'options->transformation' "$manifest"
+grep '(with-input . "guile-json@3=guile-json")' "$manifest"
+
+# Development manifest.
+guix shell --export-manifest -D guile git > "$manifest"
+grep 'package->development-manifest' "$manifest"
+grep '"guile"' "$manifest"
+guix build -m "$manifest" -d | \
+ grep "$(guix build -e '(@@ (gnu packages commencement) gcc-final)' -d)"
+guix build -m "$manifest" -d | \
+ grep "$(guix build git -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)"
+
+# Test various combinations to make sure generated code uses interfaces
+# correctly.
+for options in \
+ "coreutils grep sed" \
+ "gsl openblas gcc-toolchain --tune" \
+ "guile -m $manifest.previous" \
+ "git:send-email gdb guile:debug" \
+ "git -D coreutils"
+do
+ guix shell --export-manifest $options > "$manifest"
+ cat "$manifest"
+ guix shell -m "$manifest" -n
+ mv "$manifest" "$manifest.previous"
+done
diff --git a/tests/hackage.scm b/tests/hackage.scm
index 189b9af173..ad2ee4b7f9 100644
--- a/tests/hackage.scm
+++ b/tests/hackage.scm
@@ -156,6 +156,31 @@ library
Exposed-Modules:
Test.QuickCheck.Exception")
+(define test-read-cabal-2
+ "name: test-me
+common defaults
+ if os(foobar) { cc-options: -DBARBAZ }
+") ; Intentional newline.
+
+;; Test opening bracket on new line.
+(define test-read-cabal-brackets-newline
+ "name: test-me
+common defaults
+ build-depends:
+ { foobar
+ , barbaz
+ }
+")
+
+;; Test library with (since Cabal 2.0) and without names.
+(define test-read-cabal-library-name
+ "name: test-me
+library foobar
+ build-depends: foo, bar
+library
+ build-depends: bar, baz
+")
+
(test-begin "hackage")
(define-syntax-rule (define-package-matcher name pattern)
@@ -309,6 +334,165 @@ executable cabal
(test-assert "hackage->guix-package test flag executable"
(eval-test-with-cabal test-cabal-flag-executable match-ghc-foo))
+;; There is no mandatory space between property name and value.
+(define test-cabal-property-no-space
+ "name:foo
+version:1.0.0
+homepage:http://test.org
+synopsis:synopsis
+description:description
+license:BSD3
+common bench-defaults
+ ghc-options:-Wall
+executable cabal
+ build-depends:
+ HTTP >= 4000.2.5 && < 4000.3,
+ mtl >= 2.0 && < 3
+")
+
+(test-assert "hackage->guix-package test properties without space"
+ (eval-test-with-cabal test-cabal-property-no-space match-ghc-foo))
+
+;; There may be no final newline terminating a property.
+(define test-cabal-no-final-newline
+"name: foo
+version: 1.0.0
+homepage: http://test.org
+synopsis: synopsis
+description: description
+license: BSD3
+executable cabal
+ build-depends: HTTP >= 4000.2.5 && < 4000.3, mtl >= 2.0 && < 3")
+
+(test-expect-fail 1)
+(test-assert "hackage->guix-package test without final newline"
+ (eval-test-with-cabal test-cabal-no-final-newline match-ghc-foo))
+
+;; Make sure internal libraries will not be part of the dependencies,
+;; ignore case.
+(define test-cabal-internal-library-ignored
+ "name: foo
+version: 1.0.0
+homepage: http://test.org
+synopsis: synopsis
+description: description
+license: BSD3
+executable cabal
+ build-depends:
+ HTTP >= 4000.2.5 && < 4000.3,
+ internAl
+library internaL
+ build-depends: mtl >= 2.0 && < 3
+")
+
+(test-assert "hackage->guix-package test internal libraries are ignored"
+ (eval-test-with-cabal test-cabal-internal-library-ignored match-ghc-foo))
+
+;; Check if-elif-else statements
+(define test-cabal-if
+ "name: foo
+version: 1.0.0
+homepage: http://test.org
+synopsis: synopsis
+description: description
+license: BSD3
+library
+ if os(first)
+ Build-depends: ghc-c
+")
+
+(define test-cabal-else
+ "name: foo
+version: 1.0.0
+homepage: http://test.org
+synopsis: synopsis
+description: description
+license: BSD3
+library
+ if os(first)
+ Build-depends: ghc-a
+ else
+ Build-depends: ghc-c
+")
+
+(define test-cabal-elif
+ "name: foo
+version: 1.0.0
+homepage: http://test.org
+synopsis: synopsis
+description: description
+license: BSD3
+library
+ if os(first)
+ Build-depends: ghc-a
+ elif os(second)
+ Build-depends: ghc-b
+ elif os(guix)
+ Build-depends: ghc-c
+ elif os(third)
+ Build-depends: ghc-d
+ else
+ Build-depends: ghc-e
+")
+
+;; Try the same with different bracket styles
+(define test-cabal-elif-brackets
+ "name: foo
+version: 1.0.0
+homepage: http://test.org
+synopsis: synopsis
+description: description
+license: BSD3
+library
+ if os(first) {
+ Build-depends: ghc-a
+ }
+ elif os(second)
+ Build-depends: ghc-b
+ elif os(guix) { Build-depends: ghc-c }
+ elif os(third) {
+ Build-depends: ghc-d }
+ elif os(fourth)
+ {
+ Build-depends: ghc-d
+ } else
+ Build-depends: ghc-e
+")
+
+(define-package-matcher match-ghc-elif
+ ('package
+ ('name "ghc-foo")
+ ('version "1.0.0")
+ ('source
+ ('origin
+ ('method 'url-fetch)
+ ('uri ('hackage-uri "foo" 'version))
+ ('sha256
+ ('base32
+ (? string? hash)))))
+ ('build-system 'haskell-build-system)
+ ('inputs ('list 'ghc-c))
+ ('home-page "http://test.org")
+ ('synopsis (? string?))
+ ('description (? string?))
+ ('license 'license:bsd-3)))
+
+(test-assert "hackage->guix-package test lonely if statement"
+ (eval-test-with-cabal test-cabal-else match-ghc-elif
+ #:cabal-environment '(("os" . "guix"))))
+
+(test-assert "hackage->guix-package test else statement"
+ (eval-test-with-cabal test-cabal-else match-ghc-elif
+ #:cabal-environment '(("os" . "guix"))))
+
+(test-assert "hackage->guix-package test elif statement"
+ (eval-test-with-cabal test-cabal-elif match-ghc-elif
+ #:cabal-environment '(("os" . "guix"))))
+
+(test-assert "hackage->guix-package test elif statement with brackets"
+ (eval-test-with-cabal test-cabal-elif-brackets match-ghc-elif
+ #:cabal-environment '(("os" . "guix"))))
+
;; Check Hackage Cabal revisions.
(define test-cabal-revision
"name: foo
@@ -352,7 +536,7 @@ executable cabal
(test-assert "read-cabal test 1"
(match (call-with-input-string test-read-cabal-1 read-cabal)
((("name" ("test-me"))
- ('section 'library
+ ('section 'library #f
(('if ('flag "base4point8")
(("build-depends" ("base >= 4.8 && < 5")))
(('if ('flag "base4")
@@ -369,6 +553,35 @@ executable cabal
#t)
(x (pk 'fail x #f))))
+(test-assert "read-cabal test: if brackets on the same line"
+ (match (call-with-input-string test-read-cabal-2 read-cabal)
+ ((("name" ("test-me"))
+ ('section 'common "defaults"
+ (('if ('os "foobar")
+ (("cc-options" ("-DBARBAZ ")))
+ ()))))
+ #t)
+ (x (pk 'fail x #f))))
+
+(test-expect-fail 1)
+(test-assert "read-cabal test: property brackets on new line"
+ (match (call-with-input-string test-read-cabal-brackets-newline read-cabal)
+ ((("name" ("test-me"))
+ ('section 'common "defaults"
+ (("build-depends" ("foobar , barbaz")))))
+ #t)
+ (x (pk 'fail x #f))))
+
+(test-assert "read-cabal test: library name"
+ (match (call-with-input-string test-read-cabal-library-name read-cabal)
+ ((("name" ("test-me"))
+ ('section 'library "foobar"
+ (("build-depends" ("foo, bar"))))
+ ('section 'library #f
+ (("build-depends" ("bar, baz")))))
+ #t)
+ (x (pk 'fail x #f))))
+
(define test-cabal-import
"name: foo
version: 1.0.0
diff --git a/tests/home-import.scm b/tests/home-import.scm
index ca8aa95431..d62a6de648 100644
--- a/tests/home-import.scm
+++ b/tests/home-import.scm
@@ -103,8 +103,8 @@ corresponding file."
('gnu 'services))
('home-environment
('packages
- ('map ('compose 'list 'specification->package+output)
- ('list "guile@2.0.9" "gcc:lib" "glibc@2.19")))
+ ('specifications->packages
+ ('list "guile@2.0.9" "gcc:lib" "glibc@2.19")))
('services
('list)))))
@@ -132,8 +132,7 @@ corresponding file."
('gnu 'services))
('home-environment
('packages
- ('map ('compose 'list 'specification->package+output)
- ('list)))
+ ('specifications->packages ('list)))
('services
('list)))))
@@ -147,8 +146,7 @@ corresponding file."
('gnu 'home 'services 'shells))
('home-environment
('packages
- ('map ('compose 'list 'specification->package+output)
- ('list)))
+ ('specifications->packages ('list)))
('services
('list ('service
'home-bash-service-type
@@ -168,8 +166,7 @@ corresponding file."
('gnu 'home 'services 'shells))
('home-environment
('packages
- ('map ('compose 'list 'specification->package+output)
- ('list)))
+ ('specifications->packages ('list)))
('services
('list ('service
'home-bash-service-type
diff --git a/tests/home-services.scm b/tests/home-services.scm
new file mode 100644
index 0000000000..e13733cabd
--- /dev/null
+++ b/tests/home-services.scm
@@ -0,0 +1,46 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2022 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; 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-home-services)
+ #:use-module (gnu services)
+ #:use-module (gnu home services)
+ #:use-module (guix diagnostics)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-64)
+ #:use-module (ice-9 match))
+
+(test-begin "home-services")
+
+(test-assert "fold-home-service-types"
+ (match (fold-home-service-types cons '())
+ (() #f)
+ (lst (and (every service-type? lst)
+ (every (lambda (type)
+ (let ((location (service-type-location type)))
+ (string-contains (location-file location)
+ "gnu/home")))
+ lst)))))
+
+(test-eq "lookup-service-types"
+ home-files-service-type
+ (and (null? (lookup-home-service-types 'does-not-exist-at-all))
+ (match (lookup-home-service-types 'home-files)
+ ((one) one)
+ (x x))))
+
+(test-end)
diff --git a/tests/inferior.scm b/tests/inferior.scm
index 9992077cb2..56b2fcb7bc 100644
--- a/tests/inferior.scm
+++ b/tests/inferior.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018-2022 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -62,6 +62,20 @@
(close-inferior inferior)
(list a (inferior-object? b))))))
+(test-equal "close-inferior"
+ '((hello) (world))
+ (let* ((inferior1 (open-inferior %top-builddir #:command "scripts/guix"))
+ (lst1 (inferior-eval '(list 'hello) inferior1))
+ (inferior2 (open-inferior %top-builddir #:command "scripts/guix"))
+ (lst2 (inferior-eval '(list 'world) inferior2)))
+ ;; This call succeeds if and only if INFERIOR2 does not also hold a file
+ ;; descriptor to the socketpair beneath INFERIOR1; otherwise it blocks.
+ ;; See <https://issues.guix.gnu.org/55441#10>.
+ (close-inferior inferior1)
+
+ (close-inferior inferior2)
+ (list lst1 lst2)))
+
(test-equal "&inferior-exception"
'(a b c d)
(let ((inferior (open-inferior %top-builddir
diff --git a/tests/keys/ed25519-2.pub b/tests/keys/ed25519-2.pub
index f5329105d5..ef050e3845 100644
--- a/tests/keys/ed25519-2.pub
+++ b/tests/keys/ed25519-2.pub
@@ -1,10 +1,9 @@
-----BEGIN PGP PUBLIC KEY BLOCK-----
mDMEXtVsNhYJKwYBBAHaRw8BAQdAnLsYdh3BpeK1xDguJE80XW2/MSmqeeP6pbQw
-8jAw0OG0IkNoYXJsaWUgR3VpeCA8Y2hhcmxpZUBleGFtcGxlLm9yZz6IlgQTFggA
-PhYhBKBDaY1jer75FlruS4IkDtyrgNqDBQJe1Ww2AhsDBQkDwmcABQsJCAcCBhUK
-CQgLAgQWAgMBAh4BAheAAAoJEIIkDtyrgNqDM6cA/idDdoxo9SU+witdTXt24APH
-yRzHbX9Iyh4dZNIek9JwAP9E0BwSvDHB4LY9z4RWf2hJp3dm/yZ/jEpK+w4BGN4J
-Ag==
-=JIU0
+8jAw0OG0IkNoYXJsaWUgR3VpeCA8Y2hhcmxpZUBleGFtcGxlLm9yZz6IkAQTFggA
+OAIbAwULCQgHAgYVCgkICwIEFgIDAQIeAQIXgBYhBKBDaY1jer75FlruS4IkDtyr
+gNqDBQJihWJtAAoJEIIkDtyrgNqDbs0BAPOaGSYf3pX3DReEe1zbxxVQrolX9/AZ
+VP0AOt0TAgkzAP0Sr7G1NuCtjWWGK1WmlyTFPhOWLhNriKgZFkBZrGypAw==
+=pdTB
-----END PGP PUBLIC KEY BLOCK-----
diff --git a/tests/keys/ed25519-3.pub b/tests/keys/ed25519-3.pub
index 72f311984c..057f29577e 100644
--- a/tests/keys/ed25519-3.pub
+++ b/tests/keys/ed25519-3.pub
@@ -1,9 +1,9 @@
-----BEGIN PGP PUBLIC KEY BLOCK-----
mDMEYVH/7xYJKwYBBAHaRw8BAQdALMLeUhjEG2/UPCJj2j/debFwwAK5gT3G0l5d
-ILfFldm0FTxleGFtcGxlQGV4YW1wbGUuY29tPoiWBBMWCAA+FiEEjO6M85jMSK68
-7tINGBzA7NyoagkFAmFR/+8CGwMFCQPCZwAFCwkIBwIGFQoJCAsCBBYCAwECHgEC
-F4AACgkQGBzA7Nyoagl3lgEAw6yqIlX11lTqwxBGhZk/Oy34O13cbJSZCGv+m0ja
-+hcA/3DCNOmT+oXjgO/w6enQZUQ1m/d6dUjCc2wOLlLz+ZoG
-=+r3i
+ILfFldm0FTxleGFtcGxlQGV4YW1wbGUuY29tPoiQBBMWCAA4AhsDBQsJCAcCBhUK
+CQgLAgQWAgMBAh4BAheAFiEEjO6M85jMSK687tINGBzA7NyoagkFAmKFYrUACgkQ
+GBzA7Nyoagm2/AD9GSZqQAtEsauo5/LvH3XF7bDDnYCo/SmVCzyLM98+qCsA/2fy
+kKnsGE5kwTGRrNvgn+5ROCCcHFSpwxzWcAwd9S4H
+=OEKB
-----END PGP PUBLIC KEY BLOCK-----
diff --git a/tests/keys/ed25519.pub b/tests/keys/ed25519.pub
index f6bf906783..5a2fccc9f9 100644
--- a/tests/keys/ed25519.pub
+++ b/tests/keys/ed25519.pub
@@ -2,9 +2,9 @@
mDMEXqNaoBYJKwYBBAHaRw8BAQdArviKtelb4g0I3zx9xyDS40Oz8i1/LRXqppG6
b23Hdim0KEVkIFR3by1GaWZ0eSA8bHVkbyt0ZXN0LWVjY0BjaGJvdWliLm9yZz6I
-lgQTFggAPhYhBETTHiGvcTj5tjIoCncfScv6rgctBQJeo1qgAhsDBQkDwmcABQsJ
-CAcCBhUKCQgLAgQWAgMBAh4BAheAAAoJEHcfScv6rgctq4MA/1R9G0roEwrHwmTd
-DHxt211eLqupwXE0Z7xY2FH6DHk9AP4owEefBU7jQprSAzBS+c6gdS3SCCKKqAh6
-ToZ4LmbKAw==
-=FXMK
+kAQTFggAOAIbAwULCQgHAgYVCgkICwIEFgIDAQIeAQIXgBYhBETTHiGvcTj5tjIo
+CncfScv6rgctBQJihWH6AAoJEHcfScv6rgctfPMBAPv+yPmEgM+J6D1nZjXsO4zW
++4e3y2Ez+QxgI2tn8Z2xAQDBUWyyu0X+8dguGmVlsaiQdkazaUSpexvIhh9zONYw
+Bg==
+=s4Vp
-----END PGP PUBLIC KEY BLOCK-----
diff --git a/tests/lint.scm b/tests/lint.scm
index 6bb24370da..8be74d2604 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -5,7 +5,7 @@
;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;; Copyright © 2017 Alex Kost <alezost@gmail.com>
-;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2017, 2022 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2018, 2019 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2020 Timothy Sample <samplet@ngyro.com>
;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
@@ -1102,6 +1102,15 @@
(single-lint-warning-message
(check-mirror-url (dummy-package "x" (source source))))))
+(test-equal "mirror-url: kde suggestion"
+ "URL should be 'mirror://kde/stable/gcompris/qt/src/gcompris-qt-2.3.tar.xz'"
+ (let ((source (origin
+ (method url-fetch)
+ (uri "https://download.kde.org/stable/gcompris/qt/src/gcompris-qt-2.3.tar.xz")
+ (sha256 %null-sha256))))
+ (single-lint-warning-message
+ (check-mirror-url (dummy-package "x" (source source))))))
+
(test-equal "github-url"
'()
(with-http-server `((200 ,%long-string))
diff --git a/tests/packages.scm b/tests/packages.scm
index 710eace6dc..6cbc34ba0b 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -1923,6 +1923,19 @@
(package-location (specification->package "guile@2"))
(specification->location "guile@2"))
+(test-equal "package-unique-version-prefix, gcc@8"
+ "8"
+ (let ((gcc (specification->package "gcc-toolchain@8")))
+ (package-unique-version-prefix (package-name gcc)
+ (package-version gcc))))
+
+(test-equal "package-unique-version-prefix, grep"
+ ""
+ (let ((grep (specification->package "grep")))
+ (package-unique-version-prefix (package-name grep)
+ (package-version grep))))
+
+
(test-eq "this-package-input, exists"
hello
(package-arguments
diff --git a/tests/profiles.scm b/tests/profiles.scm
index d59d75985f..7418b7470f 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -471,7 +471,7 @@
(test-assert "package->manifest-entry, search paths"
;; See <http://bugs.gnu.org/22073>.
- (let ((mpl (@ (gnu packages python-xyz) python2-matplotlib)))
+ (let ((mpl (@ (gnu packages python-xyz) python-matplotlib)))
(lset= eq?
(package-transitive-native-search-paths mpl)
(manifest-entry-search-paths
diff --git a/tests/publish.scm b/tests/publish.scm
index 47c5eabca0..efb5698bed 100644
--- a/tests/publish.scm
+++ b/tests/publish.scm
@@ -41,12 +41,15 @@
#:autoload (zstd) (call-with-zstd-input-port)
#:use-module (web uri)
#:use-module (web client)
+ #:use-module (web request)
#:use-module (web response)
+ #:use-module ((guix http-client) #:select (http-multiple-get))
#:use-module (rnrs bytevectors)
#:use-module (ice-9 binary-ports)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-64)
+ #:use-module (srfi srfi-71)
#:use-module (ice-9 threads)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
@@ -166,6 +169,26 @@ FileSize: ~a\n"
(publish-uri
(string-append "/" (store-path-hash-part %item) ".narinfo")))))
+(test-equal "/*.narinfo pipeline"
+ (make-list 500 200)
+ ;; Make sure clients can pipeline requests and correct responses, in the
+ ;; right order. See <https://issues.guix.gnu.org/54723>.
+ (let* ((uri (string->uri (publish-uri
+ (string-append "/"
+ (store-path-hash-part %item)
+ ".narinfo"))))
+ (_ expected (http-get uri #:streaming? #f #:decode-body? #f)))
+ (http-multiple-get (string->uri (publish-uri ""))
+ (lambda (request response port result)
+ (and (bytevector=? expected
+ (get-bytevector-n port
+ (response-content-length
+ response)))
+ (cons (response-code response) result)))
+ '()
+ (make-list 500 (build-request uri))
+ #:batch-size 77)))
+
(test-equal "/*.narinfo with properly encoded '+' sign"
;; See <http://bugs.gnu.org/21888>.
(let* ((item (add-text-to-store %store "fake-gtk+" "Congrats!"))
diff --git a/tests/services.scm b/tests/services.scm
index 572fe38164..8e35758209 100644
--- a/tests/services.scm
+++ b/tests/services.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015-2019, 2022 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -30,8 +30,10 @@
(test-equal "services, default value"
'(42 123 234 error)
- (let* ((t1 (service-type (name 't1) (extensions '())))
+ (let* ((t1 (service-type (name 't1) (extensions '())
+ (description "")))
(t2 (service-type (name 't2) (extensions '())
+ (description "")
(default-value 42))))
(list (service-value (service t2))
(service-value (service t2 123))
@@ -40,13 +42,13 @@
(service t1)))))
(test-assert "service-back-edges"
- (let* ((t1 (service-type (name 't1) (extensions '())
+ (let* ((t1 (service-type (name 't1) (extensions '()) (description "")
(compose +) (extend *)))
- (t2 (service-type (name 't2)
+ (t2 (service-type (name 't2) (description "")
(extensions
(list (service-extension t1 (const '()))))
(compose +) (extend *)))
- (t3 (service-type (name 't3)
+ (t3 (service-type (name 't3) (description "")
(extensions
(list (service-extension t2 identity)
(service-extension t1 list)))))
@@ -63,16 +65,16 @@
;; from services of type T3; 'xyz 60' comes from the service of type T2,
;; where 60 = 15 × 4 = (1 + 2 + 3 + 4 + 5) × 4.
'(initial-value 5 4 3 2 1 xyz 60)
- (let* ((t1 (service-type (name 't1) (extensions '())
+ (let* ((t1 (service-type (name 't1) (extensions '()) (description "")
(compose concatenate)
(extend cons)))
- (t2 (service-type (name 't2)
+ (t2 (service-type (name 't2) (description "")
(extensions
(list (service-extension t1
(cut list 'xyz <>))))
(compose (cut reduce + 0 <>))
(extend *)))
- (t3 (service-type (name 't3)
+ (t3 (service-type (name 't3) (description "")
(extensions
(list (service-extension t2 identity)
(service-extension t1 list)))))
@@ -86,10 +88,10 @@
(service-value r))))
(test-assert "fold-services, ambiguity"
- (let* ((t1 (service-type (name 't1) (extensions '())
+ (let* ((t1 (service-type (name 't1) (extensions '()) (description "")
(compose concatenate)
(extend cons)))
- (t2 (service-type (name 't2)
+ (t2 (service-type (name 't2) (description "")
(extensions
(list (service-extension t1 list)))))
(s (service t2 42)))
@@ -105,8 +107,8 @@
#f)))
(test-assert "fold-services, missing target"
- (let* ((t1 (service-type (name 't1) (extensions '())))
- (t2 (service-type (name 't2)
+ (let* ((t1 (service-type (name 't1) (extensions '()) (description "")))
+ (t2 (service-type (name 't2) (description "")
(extensions
(list (service-extension t1 list)))))
(s (service t2 42)))
@@ -119,11 +121,11 @@
#f)))
(test-assert "instantiate-missing-services"
- (let* ((t1 (service-type (name 't1) (extensions '())
+ (let* ((t1 (service-type (name 't1) (extensions '()) (description "")
(default-value 'dflt)
(compose concatenate)
(extend cons)))
- (t2 (service-type (name 't2)
+ (t2 (service-type (name 't2) (description "")
(extensions
(list (service-extension t1 list)))))
(s1 (service t1 'hey!))
@@ -135,17 +137,17 @@
(instantiate-missing-services (list s1 s2))))))
(test-assert "instantiate-missing-services, indirect"
- (let* ((t1 (service-type (name 't1) (extensions '())
+ (let* ((t1 (service-type (name 't1) (extensions '()) (description "")
(default-value 'dflt)
(compose concatenate)
(extend cons)))
- (t2 (service-type (name 't2)
+ (t2 (service-type (name 't2) (description "")
(default-value 'dflt2)
(compose concatenate)
(extend cons)
(extensions
(list (service-extension t1 list)))))
- (t3 (service-type (name 't3)
+ (t3 (service-type (name 't3) (description "")
(extensions
(list (service-extension t2 list)))))
(s1 (service t1))
@@ -160,8 +162,8 @@
(instantiate-missing-services (list s2 s3))))))
(test-assert "instantiate-missing-services, no default value"
- (let* ((t1 (service-type (name 't1) (extensions '())))
- (t2 (service-type (name 't2)
+ (let* ((t1 (service-type (name 't1) (extensions '()) (description "")))
+ (t2 (service-type (name 't2) (description "")
(extensions
(list (service-extension t1 list)))))
(s (service t2 42)))
@@ -212,9 +214,9 @@
;; because it is not currently running. 'baz' is loaded because it's
;; a new service.
(shepherd-service-upgrade
- (list (live-service '(foo) '() #t)
- (live-service '(bar) '() #f)
- (live-service '(root) '() #t)) ;essential!
+ (list (live-service '(foo) '() #f #t)
+ (live-service '(bar) '() #f #f)
+ (live-service '(root) '() #f #t)) ;essential!
(list (shepherd-service (provision '(foo))
(start #t))
(shepherd-service (provision '(bar))
@@ -234,9 +236,9 @@
;; unloaded because 'foo' depends on it. 'foo' gets replaced but it
;; must be restarted manually.
(shepherd-service-upgrade
- (list (live-service '(foo) '(bar) #t)
- (live-service '(bar) '() #t) ;still used!
- (live-service '(baz) '() #t))
+ (list (live-service '(foo) '(bar) #f #t)
+ (live-service '(bar) '() #f #t) ;still used!
+ (live-service '(baz) '() #f #t))
(list (shepherd-service (provision '(foo))
(start #t)))))
(lambda (unload restart)
@@ -251,9 +253,26 @@
;; 'foo', 'bar', and 'baz' depend on each other, but all of them are
;; obsolete, and thus should be unloaded.
(shepherd-service-upgrade
- (list (live-service '(foo) '(bar) #t) ;obsolete
- (live-service '(bar) '(baz) #t) ;obsolete
- (live-service '(baz) '() #t)) ;obsolete
+ (list (live-service '(foo) '(bar) #f #t) ;obsolete
+ (live-service '(bar) '(baz) #f #t) ;obsolete
+ (live-service '(baz) '() #f #t)) ;obsolete
+ (list (shepherd-service (provision '(qux))
+ (start #t)))))
+ (lambda (unload restart)
+ (list (map live-service-provision unload)
+ (map shepherd-service-provision restart)))))
+
+(test-equal "shepherd-service-upgrade: transient service"
+ ;; Transient service must not be unloaded:
+ ;; <https://issues.guix.gnu.org/54812>.
+ '(((foo)) ;unload
+ ((qux))) ;restart
+ (call-with-values
+ (lambda ()
+ (shepherd-service-upgrade
+ (list (live-service '(sshd-42) '() #t 42) ;transient
+ (live-service '(foo) '() #f #t) ;obsolete
+ (live-service '(qux) '() #f #t)) ;running
(list (shepherd-service (provision '(qux))
(start #t)))))
(lambda (unload restart)
diff --git a/tests/style.scm b/tests/style.scm
index 8c6d37a661..41f7e31cce 100644
--- a/tests/style.scm
+++ b/tests/style.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021-2022 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -377,7 +377,14 @@
(list (package-inputs (@ (my-packages) my-coreutils))
(read-package-field (@ (my-packages) my-coreutils) 'inputs 4)))))
+(test-equal "read-with-comments: dot notation"
+ (cons 'a 'b)
+ (call-with-input-string "(a . b)"
+ read-with-comments))
+
(test-pretty-print "(list 1 2 3 4)")
+(test-pretty-print "((a . 1) (b . 2))")
+(test-pretty-print "(a b c . boom)")
(test-pretty-print "(list 1
2
3
diff --git a/tests/transformations.scm b/tests/transformations.scm
index 8db85b4305..dbfe523518 100644
--- a/tests/transformations.scm
+++ b/tests/transformations.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2017, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016-2017, 2019-2022 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2021 Marius Bakke <marius@gnu.org>
;;;
;;; This file is part of GNU Guix.
@@ -451,6 +451,18 @@
(string=? (local-file-file input) patch)))
inputs))))))))
+(test-equal "options->transformation, property order"
+ ;; See <https://issues.guix.gnu.org/54942>.
+ '((with-debug-info . "does-not-exist")
+ (with-commit . "does-not-exist=aaaaaaa")
+ (without-tests . "does-not-exist"))
+ (let* ((t (options->transformation
+ '((with-debug-info . "does-not-exist")
+ (with-commit . "does-not-exist=aaaaaaa")
+ (without-tests . "does-not-exist")))))
+ (let ((new (t coreutils)))
+ (assq-ref (package-properties new) 'transformations))))
+
(test-equal "options->transformation, with-latest"
"42.0"
(mock ((guix upstream) %updaters
generated by cgit