Merge branch 'master' into core-updates

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" '()))