diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/build-utils.scm | 52 | ||||
| -rw-r--r-- | tests/graph.scm | 28 | ||||
| -rw-r--r-- | tests/guix-pack-relocatable.sh | 21 | ||||
| -rw-r--r-- | tests/packages.scm | 51 | ||||
| -rw-r--r-- | tests/scripts-build.scm | 109 | ||||
| -rw-r--r-- | tests/scripts.scm | 15 |
6 files changed, 237 insertions, 39 deletions
diff --git a/tests/build-utils.scm b/tests/build-utils.scm index 1c9084514d..5678bb6a22 100644 --- a/tests/build-utils.scm +++ b/tests/build-utils.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2015, 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2015, 2016, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net> ;;; ;;; This file is part of GNU Guix. @@ -21,11 +21,14 @@ (define-module (test-build-utils) #:use-module (guix tests) #:use-module (guix build utils) + #:use-module ((gnu build bootloader) + #:select (invoke/quiet)) #:use-module ((guix utils) #:select (%current-system call-with-temporary-directory)) #:use-module (gnu packages) #:use-module (gnu packages bootstrap) #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) #:use-module (srfi srfi-64) #:use-module (rnrs io ports) #:use-module (ice-9 popen)) @@ -108,20 +111,39 @@ ;; it can't know about the bootstrap bash in the store, since it's not ;; named "bash". Help it out a bit by providing a symlink it this ;; package's output. - (setenv "PATH" (dirname bash)) - (wrap-program foo `("GUIX_FOO" prefix ("hello"))) - (wrap-program foo `("GUIX_BAR" prefix ("world"))) - - ;; The bootstrap Bash is linked against an old libc and would abort with - ;; an assertion failure when trying to load incompatible locale data. - (unsetenv "LOCPATH") - - (let* ((pipe (open-input-pipe foo)) - (str (get-string-all pipe))) - (with-directory-excursion directory - (for-each delete-file '("foo" ".foo-real"))) - (and (zero? (close-pipe pipe)) - str)))))) + (with-environment-variable "PATH" (dirname bash) + (wrap-program foo `("GUIX_FOO" prefix ("hello"))) + (wrap-program foo `("GUIX_BAR" prefix ("world"))) + + ;; The bootstrap Bash is linked against an old libc and would abort + ;; with an assertion failure when trying to load incompatible locale + ;; data. + (unsetenv "LOCPATH") + + (let* ((pipe (open-input-pipe foo)) + (str (get-string-all pipe))) + (with-directory-excursion directory + (for-each delete-file '("foo" ".foo-real"))) + (and (zero? (close-pipe pipe)) + str))))))) + +(test-assert "invoke/quiet, success" + (begin + (invoke/quiet "true") + #t)) + +(test-assert "invoke/quiet, failure" + (guard (c ((message-condition? c) + (string-contains (condition-message c) "This is an error."))) + (invoke/quiet "sh" "-c" "echo This is an error. ; false") + #f)) + +(test-assert "invoke/quiet, failure, message on stderr" + (guard (c ((message-condition? c) + (string-contains (condition-message c) + "This is another error."))) + (invoke/quiet "sh" "-c" "echo This is another error. >&2 ; false") + #f)) (let ((script-contents "\ #!/anything/cabbage-bash-1.2.3/bin/sh diff --git a/tests/graph.scm b/tests/graph.scm index 2a0f675717..b7732ec709 100644 --- a/tests/graph.scm +++ b/tests/graph.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -191,6 +191,32 @@ edges." (string=? target (derivation-file-name g))))) edges))))))))) +(test-assert "reverse bag DAG" + (let-values (((dune bap ocaml-base) + (values (specification->package "dune") + (specification->package "bap") + (specification->package "ocaml-base"))) + ((backend nodes+edges) (make-recording-backend))) + (run-with-store %store + (export-graph (list dune) 'port + #:node-type %reverse-bag-node-type + #:backend backend)) + + (run-with-store %store + (mlet %store-monad ((dune-drv (package->derivation dune)) + (bap-drv (package->derivation bap)) + (ocaml-base-drv (package->derivation ocaml-base))) + ;; OCAML-BASE uses 'dune-build-system' so DUNE is a direct dependency. + ;; BAP is much higher in the stack but it should be there. + (let-values (((nodes edges) (nodes+edges))) + (return + (and (member `(,(derivation-file-name bap-drv) + ,(package-full-name bap)) + nodes) + (->bool (member (map derivation-file-name + (list dune-drv ocaml-base-drv)) + edges))))))))) + (test-assert "derivation DAG" (let-values (((backend nodes+edges) (make-recording-backend))) (run-with-store %store diff --git a/tests/guix-pack-relocatable.sh b/tests/guix-pack-relocatable.sh index 554416627b..38dcf1e485 100644 --- a/tests/guix-pack-relocatable.sh +++ b/tests/guix-pack-relocatable.sh @@ -1,5 +1,5 @@ # GNU Guix --- Functional package management for GNU -# Copyright © 2018 Ludovic Courtès <ludo@gnu.org> +# Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org> # # This file is part of GNU Guix. # @@ -41,17 +41,28 @@ STORE_PARENT="`dirname $NIX_STORE_DIR`" export STORE_PARENT if test "$STORE_PARENT" = "/"; then exit 77; fi -# This test requires user namespaces and associated command-line tools. -if ! unshare -mrf sh -c 'mount -t tmpfs none "$STORE_PARENT"' +if unshare -mrf sh -c 'mount -t tmpfs none "$STORE_PARENT"' then - exit 77 + # Test the wrapper that relies on user namespaces. + relocatable_option="-R" +else + case "`uname -m`" in + x86_64|i?86) + # Test the wrapper that falls back to PRoot. + relocatable_option="-RR";; + *) + # XXX: Our 'proot' package currently fails tests on non-Intel + # architectures, so skip this by default. + exit 77;; + esac fi test_directory="`mktemp -d`" export test_directory trap 'chmod -Rf +w "$test_directory"; rm -rf "$test_directory"' EXIT -tarball="`guix pack -R -S /Bin=bin sed`" +export relocatable_option +tarball="`guix pack $relocatable_option -S /Bin=bin sed`" (cd "$test_directory"; tar xvf "$tarball") # Run that relocatable 'sed' in a user namespace where we "erase" the store by diff --git a/tests/packages.scm b/tests/packages.scm index ad972deb31..af1f76e36d 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -998,6 +998,57 @@ ((("x" dep)) (eq? dep findutils))))))))) +(test-assert "package-input-rewriting/spec" + (let* ((dep (dummy-package "chbouib" + (native-inputs `(("x" ,grep))))) + (p0 (dummy-package "example" + (inputs `(("foo" ,coreutils) + ("bar" ,grep) + ("baz" ,dep))))) + (rewrite (package-input-rewriting/spec + `(("coreutils" . ,(const sed)) + ("grep" . ,(const findutils))))) + (p1 (rewrite p0)) + (p2 (rewrite p0))) + (and (not (eq? p1 p0)) + (eq? p1 p2) ;memoization + (string=? "example" (package-name p1)) + (match (package-inputs p1) + ((("foo" dep1) ("bar" dep2) ("baz" dep3)) + (and (string=? (package-full-name dep1) + (package-full-name sed)) + (string=? (package-full-name dep2) + (package-full-name findutils)) + (string=? (package-name dep3) "chbouib") + (eq? dep3 (rewrite dep)) ;memoization + (match (package-native-inputs dep3) + ((("x" dep)) + (string=? (package-full-name dep) + (package-full-name findutils)))))))))) + +(test-assert "package-input-rewriting/spec, partial match" + (let* ((dep (dummy-package "chbouib" + (version "1") + (native-inputs `(("x" ,grep))))) + (p0 (dummy-package "example" + (inputs `(("foo" ,coreutils) + ("bar" ,dep))))) + (rewrite (package-input-rewriting/spec + `(("chbouib@123" . ,(const sed)) ;not matched + ("grep" . ,(const findutils))))) + (p1 (rewrite p0))) + (and (not (eq? p1 p0)) + (string=? "example" (package-name p1)) + (match (package-inputs p1) + ((("foo" dep1) ("bar" dep2)) + (and (string=? (package-full-name dep1) + (package-full-name coreutils)) + (eq? dep2 (rewrite dep)) ;memoization + (match (package-native-inputs dep2) + ((("x" dep)) + (string=? (package-full-name dep) + (package-full-name findutils)))))))))) + (test-equal "package-patched-vulnerabilities" '(("CVE-2015-1234") ("CVE-2016-1234" "CVE-2018-4567") diff --git a/tests/scripts-build.scm b/tests/scripts-build.scm index 190426ed06..32876e956a 100644 --- a/tests/scripts-build.scm +++ b/tests/scripts-build.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -20,9 +20,11 @@ #:use-module (guix tests) #:use-module (guix store) #:use-module (guix packages) + #:use-module (guix git-download) #:use-module (guix scripts build) #:use-module (guix ui) #:use-module (guix utils) + #:use-module (guix git) #:use-module (gnu packages) #:use-module (gnu packages base) #:use-module (gnu packages busybox) @@ -138,12 +140,15 @@ (and (not (eq? new p)) (match (package-inputs new) ((("foo" dep1) ("bar" dep2) ("baz" dep3)) - (and (eq? dep1 busybox) - (eq? dep2 findutils) + (and (string=? (package-full-name dep1) + (package-full-name busybox)) + (string=? (package-full-name dep2) + (package-full-name findutils)) (string=? (package-name dep3) "chbouib") (match (package-native-inputs dep3) ((("x" dep)) - (eq? dep findutils))))))))))) + (string=? (package-full-name dep) + (package-full-name findutils)))))))))))) (test-assert "options->transformation, with-graft" (let* ((p (dummy-package "guix.scm" @@ -164,4 +169,100 @@ ((("x" dep)) (eq? (package-replacement dep) findutils))))))))))) +(test-equal "options->transformation, with-branch" + (git-checkout (url "https://example.org") + (branch "devel") + (recursive? #t)) + (let* ((p (dummy-package "guix.scm" + (inputs `(("foo" ,grep) + ("bar" ,(dummy-package "chbouib" + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://example.org") + (commit "cabba9e"))) + (sha256 #f))))))))) + (t (options->transformation '((with-branch . "chbouib=devel"))))) + (with-store store + (let ((new (t store p))) + (and (not (eq? new p)) + (match (package-inputs new) + ((("foo" dep1) ("bar" dep2)) + (and (string=? (package-full-name dep1) + (package-full-name grep)) + (string=? (package-name dep2) "chbouib") + (package-source dep2))))))))) + +(test-equal "options->transformation, with-commit" + (git-checkout (url "https://example.org") + (commit "abcdef") + (recursive? #t)) + (let* ((p (dummy-package "guix.scm" + (inputs `(("foo" ,grep) + ("bar" ,(dummy-package "chbouib" + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://example.org") + (commit "cabba9e"))) + (sha256 #f))))))))) + (t (options->transformation '((with-commit . "chbouib=abcdef"))))) + (with-store store + (let ((new (t store p))) + (and (not (eq? new p)) + (match (package-inputs new) + ((("foo" dep1) ("bar" dep2)) + (and (string=? (package-full-name dep1) + (package-full-name grep)) + (string=? (package-name dep2) "chbouib") + (package-source dep2))))))))) + +(test-equal "options->transformation, with-git-url" + (let ((source (git-checkout (url "https://example.org") + (recursive? #t)))) + (list source source)) + (let* ((p (dummy-package "guix.scm" + (inputs `(("foo" ,grep) + ("bar" ,(dummy-package "chbouib" + (native-inputs `(("x" ,grep))))))))) + (t (options->transformation '((with-git-url . "grep=https://example.org"))))) + (with-store store + (let ((new (t store p))) + (and (not (eq? new p)) + (match (package-inputs new) + ((("foo" dep1) ("bar" dep2)) + (and (string=? (package-full-name dep1) + (package-full-name grep)) + (string=? (package-name dep2) "chbouib") + (match (package-native-inputs dep2) + ((("x" dep3)) + (map package-source (list dep1 dep3)))))))))))) + +(test-equal "options->transformation, with-git-url + with-branch" + ;; Combine the two options and make sure the 'with-branch' transformation + ;; comes after the 'with-git-url' transformation. + (let ((source (git-checkout (url "https://example.org") + (branch "BRANCH") + (recursive? #t)))) + (list source source)) + (let* ((p (dummy-package "guix.scm" + (inputs `(("foo" ,grep) + ("bar" ,(dummy-package "chbouib" + (native-inputs `(("x" ,grep))))))))) + (t (options->transformation + (reverse '((with-git-url + . "grep=https://example.org") + (with-branch . "grep=BRANCH")))))) + (with-store store + (let ((new (t store p))) + (and (not (eq? new p)) + (match (package-inputs new) + ((("foo" dep1) ("bar" dep2)) + (and (string=? (package-name dep1) "grep") + (string=? (package-name dep2) "chbouib") + (match (package-native-inputs dep2) + ((("x" dep3)) + (map package-source (list dep1 dep3)))))))))))) + + (test-end) diff --git a/tests/scripts.scm b/tests/scripts.scm index 3901710953..efee271197 100644 --- a/tests/scripts.scm +++ b/tests/scripts.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2015, 2019 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -25,19 +25,6 @@ ;; Test the (guix scripts) module. -(define-syntax-rule (with-environment-variable variable value body ...) - "Run BODY with VARIABLE set to VALUE." - (let ((orig (getenv variable))) - (dynamic-wind - (lambda () - (setenv variable value)) - (lambda () - body ...) - (lambda () - (if orig - (setenv variable orig) - (unsetenv variable)))))) - (test-begin "scripts") |