diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/derivations.scm | 34 | ||||
| -rw-r--r-- | tests/grafts.scm | 81 | ||||
| -rw-r--r-- | tests/guix-environment-container.sh | 2 | ||||
| -rw-r--r-- | tests/guix-environment.sh | 104 | ||||
| -rw-r--r-- | tests/packages.scm | 5 | ||||
| -rw-r--r-- | tests/publish.scm | 8 | ||||
| -rw-r--r-- | tests/store.scm | 26 |
7 files changed, 183 insertions, 77 deletions
diff --git a/tests/derivations.scm b/tests/derivations.scm index db96e26ab1..9b53019cc5 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -929,40 +929,6 @@ ((p2 . _) (string<? p1 p2))))))))))))) - -(test-assert "graft-derivation" - (let* ((build `(begin - (mkdir %output) - (chdir %output) - (symlink %output "self") - (call-with-output-file "text" - (lambda (output) - (format output "foo/~a/bar" ,%mkdir))) - (symlink ,%bash "sh"))) - (orig (build-expression->derivation %store "graft" build - #:inputs `(("a" ,%bash) - ("b" ,%mkdir)))) - (one (add-text-to-store %store "bash" "fake bash")) - (two (build-expression->derivation %store "mkdir" - '(call-with-output-file %output - (lambda (port) - (display "fake mkdir" port))))) - (graft (graft-derivation %store "graft" orig - (list (graft - (origin %bash) - (replacement one)) - (graft - (origin %mkdir) - (replacement two)))))) - (and (build-derivations %store (list graft)) - (let ((two (derivation->output-path two)) - (graft (derivation->output-path graft))) - (and (string=? (format #f "foo/~a/bar" two) - (call-with-input-file (string-append graft "/text") - get-string-all)) - (string=? (readlink (string-append graft "/sh")) one) - (string=? (readlink (string-append graft "/self")) graft)))))) - (test-equal "map-derivation" "hello" (let* ((joke (package-derivation %store guile-1.8)) diff --git a/tests/grafts.scm b/tests/grafts.scm new file mode 100644 index 0000000000..4a4122a3e9 --- /dev/null +++ b/tests/grafts.scm @@ -0,0 +1,81 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014, 2015, 2016 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-grafts) + #:use-module (guix derivations) + #:use-module (guix store) + #:use-module (guix utils) + #:use-module (guix grafts) + #:use-module (guix tests) + #:use-module ((gnu packages) #:select (search-bootstrap-binary)) + #:use-module (srfi srfi-64) + #:use-module (rnrs io ports)) + +(define %store + (open-connection-for-tests)) + +(define (bootstrap-binary name) + (let ((bin (search-bootstrap-binary name (%current-system)))) + (and %store + (add-to-store %store name #t "sha256" bin)))) + +(define %bash + (bootstrap-binary "bash")) +(define %mkdir + (bootstrap-binary "mkdir")) + + +(test-begin "grafts") + +(test-assert "graft-derivation" + (let* ((build `(begin + (mkdir %output) + (chdir %output) + (symlink %output "self") + (call-with-output-file "text" + (lambda (output) + (format output "foo/~a/bar" ,%mkdir))) + (symlink ,%bash "sh"))) + (orig (build-expression->derivation %store "graft" build + #:inputs `(("a" ,%bash) + ("b" ,%mkdir)))) + (one (add-text-to-store %store "bash" "fake bash")) + (two (build-expression->derivation %store "mkdir" + '(call-with-output-file %output + (lambda (port) + (display "fake mkdir" port))))) + (graft (graft-derivation %store orig + (list (graft + (origin %bash) + (replacement one)) + (graft + (origin %mkdir) + (replacement two)))))) + (and (build-derivations %store (list graft)) + (let ((two (derivation->output-path two)) + (graft (derivation->output-path graft))) + (and (string=? (format #f "foo/~a/bar" two) + (call-with-input-file (string-append graft "/text") + get-string-all)) + (string=? (readlink (string-append graft "/sh")) one) + (string=? (readlink (string-append graft "/self")) graft)))))) + +(test-end) + + +(exit (= (test-runner-fail-count (test-runner-current)) 0)) diff --git a/tests/guix-environment-container.sh b/tests/guix-environment-container.sh index 703ab31d27..aba34a3bd0 100644 --- a/tests/guix-environment-container.sh +++ b/tests/guix-environment-container.sh @@ -73,7 +73,7 @@ guix environment --container --ad-hoc --bootstrap guile-bootstrap \ -- guile -c "$mount_test_code" > $tmpdir/mounts cat "$tmpdir/mounts" -test `wc -l < $tmpdir/mounts` -eq 3 +test `wc -l < $tmpdir/mounts` -eq 4 current_dir="`cd $PWD; pwd -P`" grep -e "$current_dir$" $tmpdir/mounts # current directory diff --git a/tests/guix-environment.sh b/tests/guix-environment.sh index aed27c103c..5ad8dfa82a 100644 --- a/tests/guix-environment.sh +++ b/tests/guix-environment.sh @@ -1,5 +1,5 @@ # GNU Guix --- Functional package management for GNU -# Copyright © 2015 Ludovic Courtès <ludo@gnu.org> +# Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org> # # This file is part of GNU Guix. # @@ -34,17 +34,23 @@ mkdir "$tmpdir" export SHELL # Check the environment variables for the bootstrap Guile. -guix environment --ad-hoc guile-bootstrap --pure --search-paths > "$tmpdir/a" -guix environment --ad-hoc guile-bootstrap:out --pure --search-paths > "$tmpdir/b" +guix environment --bootstrap --ad-hoc guile-bootstrap --pure \ + --search-paths > "$tmpdir/a" +guix environment --bootstrap --ad-hoc guile-bootstrap:out --pure \ + --search-paths > "$tmpdir/b" # $PATH must appear in the search paths, and nothing else. -grep -E '^export PATH=.*guile-bootstrap-[0-9.]+/bin' "$tmpdir/a" +grep -E '^export PATH=.*profile/bin' "$tmpdir/a" test "`wc -l < "$tmpdir/a"`" = 1 +# Guile must be on $PATH. +test -x `sed -r 's/^export PATH="(.*)"/\1/' "$tmpdir/a"`/guile + cmp "$tmpdir/a" "$tmpdir/b" # Make sure the exit value is preserved. -if guix environment --ad-hoc guile-bootstrap --pure -- guile -c '(exit 42)' +if guix environment --bootstrap --ad-hoc guile-bootstrap --pure \ + -- guile -c '(exit 42)' then false else @@ -52,7 +58,8 @@ else fi # Same as above, but with deprecated -E flag. -if guix environment --ad-hoc guile-bootstrap --pure -E "guile -c '(exit 42)'" +if guix environment --bootstrap --ad-hoc guile-bootstrap --pure \ + -E "guile -c '(exit 42)'" then false else @@ -62,22 +69,29 @@ fi if guile -c '(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)' 2> /dev/null then # Compute the build environment for the initial GNU Make. - guix environment -e '(@@ (gnu packages commencement) gnu-make-boot0)' \ - --no-substitutes --search-paths --pure > "$tmpdir/a" + guix environment --bootstrap --no-substitutes --search-paths --pure \ + -e '(@@ (gnu packages commencement) gnu-make-boot0)' > "$tmpdir/a" + + # Make sure bootstrap binaries are in the profile. + profile=`grep "^export PATH" "$tmpdir/a" | sed -r 's|^.*="(.*)/bin"|\1|'` # Make sure the bootstrap binaries are all listed where they belong. - grep -E '^export PATH=.*-bootstrap-binaries-0/bin' "$tmpdir/a" - grep -E '^export CPATH=.*-gcc-bootstrap-0/include' "$tmpdir/a" - grep -E '^export CPATH=.*-glibc-bootstrap-0/include' "$tmpdir/a" - grep -E '^export LIBRARY_PATH=.*-glibc-bootstrap-0/lib' "$tmpdir/a" + grep -E "^export PATH=\"$profile/bin\"" "$tmpdir/a" + grep -E "^export CPATH=\"$profile/include\"" "$tmpdir/a" + grep -E "^export LIBRARY_PATH=\"$profile/lib\"" "$tmpdir/a" + for dep in bootstrap-binaries-0 gcc-bootstrap-0 glibc-bootstrap-0 + do + guix gc --references "$profile" | grep "$dep" + done # 'make-boot0' itself must not be listed. - if grep "make-boot0" "$tmpdir/a"; then false; else true; fi + if guix gc --references "$profile" | grep make-boot0 + then false; else true; fi # Make sure that the shell spawned with '--exec' sees the same environment # as returned by '--search-paths'. - guix environment -e '(@@ (gnu packages commencement) gnu-make-boot0)' \ - --no-substitutes --pure \ + guix environment --bootstrap --no-substitutes --pure \ + -e '(@@ (gnu packages commencement) gnu-make-boot0)' \ -- /bin/sh -c 'echo $PATH $CPATH $LIBRARY_PATH' > "$tmpdir/b" ( . "$tmpdir/a" ; echo $PATH $CPATH $LIBRARY_PATH ) > "$tmpdir/c" cmp "$tmpdir/b" "$tmpdir/c" @@ -85,45 +99,57 @@ then rm "$tmpdir"/* # Compute the build environment for the initial GNU Findutils. - guix environment -e '(@@ (gnu packages commencement) findutils-boot0)' \ - --no-substitutes --search-paths --pure > "$tmpdir/a" + guix environment --bootstrap --no-substitutes --search-paths --pure \ + -e '(@@ (gnu packages commencement) findutils-boot0)' > "$tmpdir/a" + profile=`grep "^export PATH" "$tmpdir/a" | sed -r 's|^.*="(.*)/bin"|\1|'` # Make sure the bootstrap binaries are all listed where they belong. - grep -E '^export PATH=.*-bootstrap-binaries-0/bin' "$tmpdir/a" - grep -E '^export PATH=.*-make-boot0-[0-9.]+/bin' "$tmpdir/a" - grep -E '^export CPATH=.*-gcc-bootstrap-0/include' "$tmpdir/a" - grep -E '^export CPATH=.*-glibc-bootstrap-0/include' "$tmpdir/a" - grep -E '^export LIBRARY_PATH=.*-glibc-bootstrap-0/lib' "$tmpdir/a" + grep -E "^export PATH=\"$profile/bin\"" "$tmpdir/a" + grep -E "^export CPATH=\"$profile/include\"" "$tmpdir/a" + grep -E "^export LIBRARY_PATH=\"$profile/lib\"" "$tmpdir/a" + for dep in bootstrap-binaries-0 gcc-bootstrap-0 glibc-bootstrap-0 \ + make-boot0 + do + guix gc --references "$profile" | grep "$dep" + done # The following test assumes 'make-boot0' has a "debug" output. make_boot0_debug="`guix build -e '(@@ (gnu packages commencement) gnu-make-boot0)' | grep -e -debug`" test "x$make_boot0_debug" != "x" # Make sure the "debug" output is not listed. - if grep -E "$make_boot0_debug" "$tmpdir/a"; then false; else true; fi + if guix gc --references "$profile" | grep "$make_boot0_debug" + then false; else true; fi # Compute the build environment for the initial GNU Make, but add in the # bootstrap Guile as an ad-hoc addition. - guix environment -e '(@@ (gnu packages commencement) gnu-make-boot0)' \ - --ad-hoc guile-bootstrap --no-substitutes --search-paths \ - --pure > "$tmpdir/a" + guix environment --bootstrap --no-substitutes --search-paths --pure \ + -e '(@@ (gnu packages commencement) gnu-make-boot0)' \ + --ad-hoc guile-bootstrap > "$tmpdir/a" + profile=`grep "^export PATH" "$tmpdir/a" | sed -r 's|^.*="(.*)/bin"|\1|'` # Make sure the bootstrap binaries are all listed where they belong. - cat $tmpdir/a - grep -E '^export PATH=.*-bootstrap-binaries-0/bin' "$tmpdir/a" - grep -E '^export PATH=.*-guile-bootstrap-2.0/bin' "$tmpdir/a" - grep -E '^export CPATH=.*-gcc-bootstrap-0/include' "$tmpdir/a" - grep -E '^export CPATH=.*-glibc-bootstrap-0/include' "$tmpdir/a" - grep -E '^export LIBRARY_PATH=.*-glibc-bootstrap-0/lib' "$tmpdir/a" - - # Make sure a package list can be used with -e. + grep -E "^export PATH=\"$profile/bin\"" "$tmpdir/a" + grep -E "^export CPATH=\"$profile/include\"" "$tmpdir/a" + grep -E "^export LIBRARY_PATH=\"$profile/lib\"" "$tmpdir/a" + for dep in bootstrap-binaries-0 gcc-bootstrap-0 glibc-bootstrap-0 \ + guile-bootstrap + do + guix gc --references "$profile" | grep "$dep" + done + + # Make sure a package list with plain package objects and package+output + # tuples can be used with -e. expr_list_test_code=" (list (@@ (gnu packages commencement) gnu-make-boot0) - (@ (gnu packages bootstrap) %bootstrap-guile))" + (list (@ (gnu packages bootstrap) %bootstrap-guile) \"out\"))" - guix environment --ad-hoc --no-substitutes --search-paths --pure \ - -e "$expr_list_test_code" > "$tmpdir/a" + guix environment --bootstrap --ad-hoc --no-substitutes --search-paths \ + --pure -e "$expr_list_test_code" > "$tmpdir/a" + profile=`grep "^export PATH" "$tmpdir/a" | sed -r 's|^.*="(.*)/bin"|\1|'` - grep -E '^export PATH=.*-make-boot0-4.1/bin' "$tmpdir/a" - grep -E '^export PATH=.*-guile-bootstrap-2.0/bin' "$tmpdir/a" + for dep in make-boot0 guile-bootstrap + do + guix gc --references "$profile" | grep "$dep" + done fi diff --git a/tests/packages.scm b/tests/packages.scm index 9d37fb68d6..6315c2204f 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -29,6 +29,7 @@ #:use-module (guix hash) #:use-module (guix derivations) #:use-module (guix packages) + #:use-module (guix grafts) #:use-module (guix search-paths) #:use-module (guix build-system) #:use-module (guix build-system trivial) @@ -615,7 +616,7 @@ (guile (package-derivation %store (canonical-package guile-2.0) #:graft? #f))) (equal? (package-derivation %store dummy) - (graft-derivation %store "dummy-0" + (graft-derivation %store (package-derivation %store dummy #:graft? #f) (package-grafts %store dummy) diff --git a/tests/publish.scm b/tests/publish.scm index 0b92390900..6c710fe0a7 100644 --- a/tests/publish.scm +++ b/tests/publish.scm @@ -112,6 +112,14 @@ References: ~a~%" (call-with-input-string nar (cut restore-file <> temp))) (call-with-input-file temp read-string)))) +(test-equal "/nar/invalid" + 404 + (begin + (call-with-output-file (string-append (%store-prefix) "/invalid") + (lambda (port) + (display "This file is not a valid store item." port))) + (response-code (http-get (publish-uri (string-append "/nar/invalid")))))) + (test-end "publish") diff --git a/tests/store.scm b/tests/store.scm index 394c06bc0f..de070eab23 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 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -837,6 +837,15 @@ (file (add %store "foo" "Lowered."))) (call-with-input-file file get-string-all))) +(test-equal "current-system" + "bar" + (parameterize ((%current-system "frob")) + (run-with-store %store + (mbegin %store-monad + (set-current-system "bar") + (current-system)) + #:system "foo"))) + (test-assert "query-path-info" (let* ((ref (add-text-to-store %store "ref" "foo")) (item (add-text-to-store %store "item" "bar" (list ref))) @@ -847,6 +856,21 @@ (string->utf8 (call-with-output-string (cut write-file item <>)))))))) +(test-assert "path-info-deriver" + (let* ((b (add-text-to-store %store "build" "echo $foo > $out" '())) + (s (add-to-store %store "bash" #t "sha256" + (search-bootstrap-binary "bash" + (%current-system)))) + (d (derivation %store "the-thing" + s `("-e" ,b) + #:env-vars `(("foo" . ,(random-text))) + #:inputs `((,b) (,s)))) + (o (derivation->output-path d))) + (and (build-derivations %store (list d)) + (not (path-info-deriver (query-path-info %store b))) + (string=? (derivation-file-name d) + (path-info-deriver (query-path-info %store o)))))) + (test-end "store") |