diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/bournish.scm | 42 | ||||
| -rw-r--r-- | tests/containers.scm | 12 | ||||
| -rw-r--r-- | tests/cve.scm | 17 | ||||
| -rw-r--r-- | tests/graph.scm | 13 | ||||
| -rw-r--r-- | tests/guix-environment-container.sh | 10 | ||||
| -rw-r--r-- | tests/guix-environment.sh | 15 | ||||
| -rw-r--r-- | tests/guix-lint.sh | 2 | ||||
| -rw-r--r-- | tests/guix-package.sh | 14 | ||||
| -rw-r--r-- | tests/size.scm | 4 | ||||
| -rw-r--r-- | tests/store.scm | 39 |
10 files changed, 150 insertions, 18 deletions
diff --git a/tests/bournish.scm b/tests/bournish.scm new file mode 100644 index 0000000000..0f529ce42f --- /dev/null +++ b/tests/bournish.scm @@ -0,0 +1,42 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 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-bournish) + #:use-module (guix build bournish) + #:use-module (system base compile) + #:use-module (system base language) + #:use-module (srfi srfi-64)) + + +(test-begin "bournish") + +(test-equal "single statement" + '(chdir "/foo") + (read-and-compile (open-input-string "cd /foo") + #:from %bournish-language #:to 'scheme)) + +(test-equal "multiple statements" + '(begin + (chdir "/foo") + (getcwd) + ((@@ (guix build bournish) ls-command-implementation))) + (read-and-compile (open-input-string "cd /foo\npwd\nls") + #:from %bournish-language #:to 'scheme)) + +(test-end "bournish") + diff --git a/tests/containers.scm b/tests/containers.scm index c11cdd1ce5..5a0f9937bb 100644 --- a/tests/containers.scm +++ b/tests/containers.scm @@ -79,6 +79,18 @@ (assert-exit (file-exists? "/testing"))) #:namespaces '(user mnt)))) +(test-equal "call-with-container, mnt namespace, wrong bind mount" + `(system-error ,ENOENT) + ;; An exception should be raised; see <http://bugs.gnu.org/23306>. + (catch 'system-error + (lambda () + (call-with-container '(("/does-not-exist" device "/foo" + "none" (bind-mount) #f #f)) + (const #t) + #:namespaces '(user mnt))) + (lambda args + (list 'system-error (system-error-errno args))))) + (test-assert "call-with-container, all namespaces" (zero? (call-with-container '() diff --git a/tests/cve.scm b/tests/cve.scm index 26e710ce70..3fbb22d3c6 100644 --- a/tests/cve.scm +++ b/tests/cve.scm @@ -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. ;;; @@ -32,12 +32,10 @@ (list ;; CVE-2003-0001 has no "/a" in its product list so it is omitted. ;; CVE-2004-0230 lists "tcp" as an application, but lacks a version number. - (vulnerability "CVE-2008-2335" '(("phpvid" . "1.1") ("phpvid" . "1.2"))) - (vulnerability "CVE-2008-3522" '(("enterprise_virtualization" . "3.5") - ("jasper" . "1.900.1"))) - (vulnerability "CVE-2009-3301" '(("openoffice.org" . "2.1.0") - ("openoffice.org" . "2.3.0") - ("openoffice.org" . "2.2.1"))) + (vulnerability "CVE-2008-2335" '(("phpvid" "1.2" "1.1"))) + (vulnerability "CVE-2008-3522" '(("enterprise_virtualization" "3.5") + ("jasper" "1.900.1"))) + (vulnerability "CVE-2009-3301" '(("openoffice.org" "2.3.0" "2.2.1" "2.1.0"))) ;; CVE-2015-8330 has no software list. )) @@ -48,9 +46,8 @@ %expected-vulnerabilities (call-with-input-file %sample xml->vulnerabilities)) -(test-equal "" - (list `(("1.1" . ,(first %expected-vulnerabilities)) - ("1.2" . ,(first %expected-vulnerabilities))) +(test-equal "vulnerabilities->lookup-proc" + (list (list (first %expected-vulnerabilities)) '() '() (list (second %expected-vulnerabilities)) diff --git a/tests/graph.scm b/tests/graph.scm index 32317195d7..1ce06cc817 100644 --- a/tests/graph.scm +++ b/tests/graph.scm @@ -275,4 +275,17 @@ edges." (return (lset= eq? (node-transitive-edges (list p2) edges) (list p1a p1b p0))))))) +(test-equal "node-reachable-count" + '(3 3) + (run-with-store %store + (let* ((p0 (dummy-package "p0")) + (p1a (dummy-package "p1a" (inputs `(("p0" ,p0))))) + (p1b (dummy-package "p1b" (inputs `(("p0" ,p0))))) + (p2 (dummy-package "p2" (inputs `(("p1a" ,p1a) ("p1b" ,p1b)))))) + (mlet* %store-monad ((all -> (list p2 p1a p1b p0)) + (edges (node-edges %package-node-type all)) + (back (node-back-edges %package-node-type all))) + (return (list (node-reachable-count (list p2) edges) + (node-reachable-count (list p0) back))))))) + (test-end "graph") diff --git a/tests/guix-environment-container.sh b/tests/guix-environment-container.sh index 0a7ea481fc..5ea6c49263 100644 --- a/tests/guix-environment-container.sh +++ b/tests/guix-environment-container.sh @@ -44,6 +44,16 @@ else test $? = 42 fi +# Make sure file-not-found errors in mounts are reported. +if guix environment --container --ad-hoc --bootstrap guile-bootstrap \ + --expose=/does-not-exist -- guile -c 1 2> "$tmpdir/error" +then + false +else + grep "/does-not-exist" "$tmpdir/error" + grep "[Nn]o such file" "$tmpdir/error" +fi + # Make sure that the right directories are mapped. mount_test_code=" (use-modules (ice-9 rdelim) diff --git a/tests/guix-environment.sh b/tests/guix-environment.sh index 5ad8dfa82a..0b5123ab45 100644 --- a/tests/guix-environment.sh +++ b/tests/guix-environment.sh @@ -57,6 +57,21 @@ else test $? = 42 fi +case "`uname -m`" in + x86_64) + # On x86_64, we should be able to create a 32-bit environment. + guix environment --bootstrap --ad-hoc guile-bootstrap --pure \ + -- guile -c '(exit (string-prefix? "x86_64" %host-type))' + guix environment --bootstrap --ad-hoc guile-bootstrap --pure \ + -s i686-linux \ + -- guile -c '(exit (string-prefix? "i686" %host-type))' + ;; + *) + echo "nothing to do" >&2 + ;; +esac + + # Same as above, but with deprecated -E flag. if guix environment --bootstrap --ad-hoc guile-bootstrap --pure \ -E "guile -c '(exit 42)'" diff --git a/tests/guix-lint.sh b/tests/guix-lint.sh index c105521ec7..7ddc7c265b 100644 --- a/tests/guix-lint.sh +++ b/tests/guix-lint.sh @@ -54,7 +54,7 @@ grep_warning () # 2) the synopsis starts with a lower-case letter; # 3) the description has a single space following the end-of-sentence period. -out=`guix lint dummy 2>&1` +out=`guix lint -c synopsis,description dummy 2>&1` if [ `grep_warning "$out"` -ne 3 ] then false; else true; fi diff --git a/tests/guix-package.sh b/tests/guix-package.sh index 28c34dbc6a..68a1946aa0 100644 --- a/tests/guix-package.sh +++ b/tests/guix-package.sh @@ -140,6 +140,20 @@ rm "$profile" "$profile"-[0-9]-link guix gc -d "$real_profile" [ ! -d "$real_profile" ] +# Package transformations. + +# Make sure we get the right version number when using '--with-source'. +mkdir "$module_dir" +emacs_tarball="$module_dir/emacs-42.5.9rc7.tar.gz" +touch "$emacs_tarball" +guix package -p "$profile" -i emacs --with-source="$emacs_tarball" -n \ + 2> "$tmpfile" +grep -E 'emacs[[:blank:]]+42\.5\.9rc7[[:blank:]]+.*-emacs-42.5.9rc7' \ + "$tmpfile" +rm "$emacs_tarball" "$tmpfile" +rmdir "$module_dir" + + # # Try with the default profile. # diff --git a/tests/size.scm b/tests/size.scm index fcd590283d..068ebc1d68 100644 --- a/tests/size.scm +++ b/tests/size.scm @@ -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. ;;; @@ -54,7 +54,7 @@ (mbegin %store-monad (built-derivations (list file2)) (mlet %store-monad ((profiles (store-profile - (derivation->output-path file2))) + (list (derivation->output-path file2)))) (bash (interned-file (search-bootstrap-binary "bash" (%current-system)) "bash" diff --git a/tests/store.scm b/tests/store.scm index eeadcb94f8..38b8efce96 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -205,7 +205,8 @@ (%current-system)))) (d (derivation s "the-thing" b '("--help") #:inputs `((,b))))) - (references/substitutes s (list (derivation->output-path d) b)))))) + (references/substitutes s (list (derivation->output-path d) b)) + #f)))) (test-assert "references/substitutes with substitute info" (with-store s @@ -231,6 +232,32 @@ (,t1) ;refs of T2 ())))))) ;refs of T1 +(test-equal "substitutable-path-info when substitutes are turned off" + '() + (with-store s + (set-build-options s #:use-substitutes? #f) + (let* ((b (add-to-store s "bash" #t "sha256" + (search-bootstrap-binary "bash" + (%current-system)))) + (d (derivation s "the-thing" b '("--version") + #:inputs `((,b)))) + (o (derivation->output-path d))) + (with-derivation-narinfo d + (substitutable-path-info s (list o)))))) + +(test-equal "substitutable-paths when substitutes are turned off" + '() + (with-store s + (set-build-options s #:use-substitutes? #f) + (let* ((b (add-to-store s "bash" #t "sha256" + (search-bootstrap-binary "bash" + (%current-system)))) + (d (derivation s "the-thing" b '("--version") + #:inputs `((,b)))) + (o (derivation->output-path d))) + (with-derivation-narinfo d + (substitutable-paths s (list o)))))) + (test-assert "requisites" (let* ((t1 (add-text-to-store %store "random1" (random-text) '())) @@ -244,10 +271,12 @@ (and (= (length x) (length y)) (lset= equal? x y))) - (and (same? (requisites %store t1) (list t1)) - (same? (requisites %store t2) (list t1 t2)) - (same? (requisites %store t3) (list t1 t2 t3)) - (same? (requisites %store t4) (list t1 t2 t3 t4))))) + (and (same? (requisites %store (list t1)) (list t1)) + (same? (requisites %store (list t2)) (list t1 t2)) + (same? (requisites %store (list t3)) (list t1 t2 t3)) + (same? (requisites %store (list t4)) (list t1 t2 t3 t4)) + (same? (requisites %store (list t1 t2 t3 t4)) + (list t1 t2 t3 t4))))) (test-assert "derivers" (let* ((b (add-text-to-store %store "build" "echo $foo > $out" '())) |