summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorMarius Bakke <mbakke@fastmail.com>2019-03-23 23:16:55 +0100
committerMarius Bakke <mbakke@fastmail.com>2019-03-23 23:16:55 +0100
commit8c14f7f8a7ab0722bf4c9f92fd28ae85514d564f (patch)
treeadc5d29e9c2dcda5befa0ca81f1af8df23294947 /tests
parent2f33a7321e5e37d37f57c229c8079cb4ffd10834 (diff)
parent3374e9207f5244c20402a3c5513fe562140fef47 (diff)
downloadpatches-8c14f7f8a7ab0722bf4c9f92fd28ae85514d564f.tar
patches-8c14f7f8a7ab0722bf4c9f92fd28ae85514d564f.tar.gz
Merge branch 'staging' into core-updates
Diffstat (limited to 'tests')
-rw-r--r--tests/build-utils.scm52
-rw-r--r--tests/graph.scm28
-rw-r--r--tests/guix-pack-relocatable.sh21
-rw-r--r--tests/packages.scm51
-rw-r--r--tests/scripts-build.scm109
-rw-r--r--tests/scripts.scm15
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")