aboutsummaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/bournish.scm42
-rw-r--r--tests/containers.scm12
-rw-r--r--tests/cve.scm17
-rw-r--r--tests/graph.scm13
-rw-r--r--tests/guix-environment-container.sh10
-rw-r--r--tests/guix-environment.sh15
-rw-r--r--tests/guix-lint.sh2
-rw-r--r--tests/guix-package.sh14
-rw-r--r--tests/size.scm4
-rw-r--r--tests/store.scm39
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" '()))
generated by cgit v1.2.3 (git 2.45.0) at 2024-12-12 10:35:16 +0000