diff options
author | Ludovic Courtès <ludo@gnu.org> | 2024-01-07 21:17:02 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2024-01-07 21:29:53 +0100 |
commit | b71d2ba8785e9883f4f2d239c557c9034b6be876 (patch) | |
tree | 52858686958c4c66c6c1f7a98ae63c3269eacb15 /tests | |
parent | c5d670308cbd0a6ee67e04e58cb77fa40e8ad328 (diff) | |
parent | 5f8a993aa85554ca09bd27139230d7664107e1b6 (diff) |
Merge branch 'master' into core-updates
Change-Id: I150b4077fffca97c860439292a8d053579d64cb7
Diffstat (limited to 'tests')
-rw-r--r-- | tests/composer.scm | 88 | ||||
-rw-r--r-- | tests/gexp.scm | 54 | ||||
-rw-r--r-- | tests/go.scm | 6 | ||||
-rw-r--r-- | tests/store.scm | 25 | ||||
-rw-r--r-- | tests/utils.scm | 12 |
5 files changed, 180 insertions, 5 deletions
diff --git a/tests/composer.scm b/tests/composer.scm new file mode 100644 index 0000000000..9114fef19e --- /dev/null +++ b/tests/composer.scm @@ -0,0 +1,88 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2020 Julien Lepiller <julien@lepiller.eu> +;;; Copyright © 2023 Nicolas Graves <ngraves@ngraves.fr> +;;; +;;; 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-composer) + #:use-module (guix import composer) + #:use-module (guix base32) + #:use-module (gcrypt hash) + #:use-module (guix tests http) + #:use-module (guix grafts) + #:use-module (srfi srfi-64) + #:use-module (web client) + #:use-module (ice-9 match)) + +;; Globally disable grafts because they can trigger early builds. +(%graft? #f) + +(define test-json + "{ + \"packages\": { + \"foo/bar\": { + \"0.1\": { + \"name\": \"foo/bar\", + \"description\": \"description\", + \"keywords\": [\"testing\"], + \"homepage\": \"http://example.com\", + \"version\": \"0.1\", + \"license\": [\"BSD-3-Clause\"], + \"source\": { + \"type\": \"url\", + \"url\": \"http://example.com/Bar-0.1.tar.gz\" + }, + \"require\": {}, + \"require-dev\": {\"phpunit/phpunit\": \"1.0.0\"} + } + } + } +}") + +(define test-source + "foobar") + +(test-begin "composer") + +(test-assert "composer->guix-package" + ;; Replace network resources with sample data. + (with-http-server `((200 ,test-json) + (200 ,test-source)) + (parameterize ((%composer-base-url (%local-url)) + (current-http-proxy (%local-url))) + (match (composer->guix-package "foo/bar") + (`(package + (name "php-foo-bar") + (version "0.1") + (source (origin + (method url-fetch) + (uri "http://example.com/Bar-0.1.tar.gz") + (sha256 + (base32 + ,(? string? hash))))) + (build-system composer-build-system) + (native-inputs (list php-phpunit-phpunit)) + (synopsis "") + (description "description") + (home-page "http://example.com") + (license license:bsd-3)) + (string=? (bytevector->nix-base32-string + (call-with-input-string test-source port-sha256)) + hash)) + (x + (pk 'fail x #f)))))) + +(test-end "composer") diff --git a/tests/gexp.scm b/tests/gexp.scm index 0e3c446576..001786c13c 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -393,6 +393,30 @@ (list item)) (null? (lowered-gexp-inputs lexp))))) +(test-equal "gexp references non-existent output" + "no-default-output" + (guard (c ((derivation-missing-output-error? c) + (derivation-name (derivation-error-derivation c)))) + (let* ((obj (computed-file "no-default-output" + #~(mkdir #$output:bar))) + (exp #~(symlink #$obj #$output)) + (drv (run-with-store %store (lower-gexp exp)))) + (pk 'oops! drv #f)))) + +(test-assert "gexp-input, as first-class input" + ;; Insert a <gexp-input> record in a gexp as a way to specify which output + ;; of OBJ should be used. + (let* ((obj (computed-file "foo" #~(mkdir #$output:bar))) + (exp #~(list #$(gexp-input obj "bar"))) + (drv (run-with-store %store (lower-object obj))) + (item (derivation->output-path drv "bar")) + (lexp (run-with-store %store (lower-gexp exp)))) + (and (match (lowered-gexp-inputs lexp) + ((input) + (eq? (derivation-input-derivation input) drv))) + (equal? (lowered-gexp-sexp lexp) + `(list ,item))))) + (test-assertm "with-parameters for %current-system" (mlet* %store-monad ((system -> (match (%current-system) ("aarch64-linux" "x86_64-linux") @@ -1628,6 +1652,36 @@ importing.* \\(guix config\\) from the host" read) refs))))))) +(test-assertm "references-file, non-default output" + (let* ((exp #~(begin + (mkdir #$output) + (symlink #$%bootstrap-guile #$output:extra))) + (computed (computed-file "computed" exp + #:guile %bootstrap-guile)) + (refs1 (references-file computed + #:guile %bootstrap-guile)) + ;; Wrap COMPUTE in 'gexp-input' to get the "extra" output. + (refs2 (references-file (gexp-input computed "extra") + #:guile %bootstrap-guile))) + (mlet* %store-monad ((drv0 (lower-object %bootstrap-guile)) + (drv1 (lower-object computed)) + (drv2 (lower-object refs2)) + (drv3 (lower-object refs1))) + (mbegin %store-monad + (built-derivations (list drv2 drv3)) + (mlet %store-monad ((refs ((store-lift requisites) + (list (derivation->output-path + drv1 "extra"))))) + (return + (and (lset= string=? + (call-with-input-file (derivation->output-path drv2) + read) + refs) + (lset= string=? + (call-with-input-file (derivation->output-path drv3) + read) + (list (derivation->output-path drv1)))))))))) + (test-assert "lower-object & gexp-input-error?" (guard (c ((gexp-input-error? c) (gexp-error-invalid-input c))) diff --git a/tests/go.scm b/tests/go.scm index a70a0ddbf5..d2e8846b30 100644 --- a/tests/go.scm +++ b/tests/go.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2021 François Joulaud <francois.joulaud@radiofrance.com> -;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev> +;;; Copyright © 2021 François Joulaud <francois.joulaud@radiofrance.com> +;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev> ;;; ;;; This file is part of GNU Guix. ;;; @@ -387,7 +387,7 @@ require github.com/kr/pretty v0.2.1 "0sjjj9z1dhilhpc8pq4154czrb79z9cm044jvn75kxcjv6v5l2m5")))) (build-system go-build-system) (arguments - '(#:import-path "github.com/go-check/check")) + (list #:import-path "github.com/go-check/check")) (propagated-inputs `(("go-github-com-kr-pretty" ,go-github-com-kr-pretty))) (home-page "https://github.com/go-check/check") diff --git a/tests/store.scm b/tests/store.scm index 5df28adf0d..45948f4f43 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012-2021, 2023 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -105,7 +105,28 @@ "/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7/bin/guile"))) (not (direct-store-path? (%store-prefix))))) -(test-skip (if %store 0 15)) +(test-skip (if %store 0 18)) + +(test-equal "substitute-urls, default" + (list (getenv "GUIX_BINARY_SUBSTITUTE_URL")) + (with-store store + (set-build-options store #:use-substitutes? #t) + (substitute-urls store))) + +(test-equal "substitute-urls, client-specified URLs" + '("http://substitutes.example.org" + "http://other.example.org") + (with-store store + (set-build-options store #:use-substitutes? #t + #:substitute-urls '("http://substitutes.example.org" + "http://other.example.org")) + (substitute-urls store))) + +(test-equal "substitute-urls, disabled" + '() + (with-store store + (set-build-options store #:use-substitutes? #f) + (substitute-urls store))) (test-equal "profiles/per-user exists and is not writable" #o755 diff --git a/tests/utils.scm b/tests/utils.scm index 648e91f242..5664165c85 100644 --- a/tests/utils.scm +++ b/tests/utils.scm @@ -4,6 +4,7 @@ ;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org> ;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com> ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be> +;;; Copyright © 2023 Foundation Devices, Inc. <hello@foundationdevices.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -329,6 +330,17 @@ skip these tests." ;; However, it isn't 32-bit. ,(format #f "x86_~a-linux-gnu" (expt 2 109))))) +(test-equal "target-avr?" + '(#t #t #t #f #f) + (map target-avr? + '("avr" "avr-unknown-none" + ;; In addition LLVM also uses this form. + "avr-unknown-unknown" + ;; The AVR32 architecture also was made by Atmel/Microchip but it + ;; does not resemble the AVR family, they aren't compatible in any + ;; way. + "avr32" "avr32-unknown-none"))) + (test-end) (false-if-exception (delete-file temp-file)) |