summary refs log tree commit diff
path: root/tests
diff options
context:
space:
mode:
authorMark H Weaver <mhw@netris.org>2015-06-10 17:50:27 -0400
committerMark H Weaver <mhw@netris.org>2015-06-10 17:50:27 -0400
commit14928016556300a6763334d4279c3d117902caaf (patch)
treed0dc262b14164b82f97dd6e896ca9e93a1fabeea /tests
parent1511e0235525358abb52cf62abeb9457605b5093 (diff)
parent57cd353d87d6e9e6e882327be70b4d7b5ce863ba (diff)
downloadguix-14928016556300a6763334d4279c3d117902caaf.tar.gz
Merge branch 'master' into core-updates
Diffstat (limited to 'tests')
-rw-r--r--tests/base32.scm10
-rw-r--r--tests/derivations.scm8
-rw-r--r--tests/gexp.scm10
-rw-r--r--tests/guix-archive.sh3
-rw-r--r--tests/guix-build.sh82
-rw-r--r--tests/guix-gc.sh20
-rw-r--r--tests/guix-package-net.sh2
-rw-r--r--tests/guix-package.sh37
-rw-r--r--tests/guix-register.sh46
-rw-r--r--tests/guix-system.sh65
-rw-r--r--tests/hackage.scm88
-rw-r--r--tests/monads.scm26
-rw-r--r--tests/packages.scm30
-rw-r--r--tests/profiles.scm107
-rw-r--r--tests/store.scm54
-rw-r--r--tests/utils.scm3
16 files changed, 528 insertions, 63 deletions
diff --git a/tests/base32.scm b/tests/base32.scm
index 81d242355a..dcd926f4b8 100644
--- a/tests/base32.scm
+++ b/tests/base32.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2015 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -21,6 +21,7 @@
   #:use-module (guix base32)
   #:use-module (guix utils)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-64)
   #:use-module (ice-9 rdelim)
   #:use-module (ice-9 popen)
@@ -77,6 +78,13 @@
          ;; Examples from RFC 4648.
          (map string->utf8 '("" "f" "fo" "foo" "foob" "fooba" "foobar"))))
 
+(test-equal "&invalid-base32-character"
+  #\e
+  (guard (c ((invalid-base32-character? c)
+             (invalid-base32-character-value c)))
+    (nix-base32-string->bytevector
+     (string-append (make-string 51 #\a) "e"))))
+
 ;; The following test requires `nix-hash' in $PATH.
 (unless %have-nix-hash?
   (test-skip 1))
diff --git a/tests/derivations.scm b/tests/derivations.scm
index a8cccac34a..df5f07d117 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -499,12 +499,16 @@
            (string=? path (derivation-file-name (%guile-for-build)))))
          (derivation-prerequisites drv))))
 
-(test-assert "derivation-prerequisites and derivation-input-is-valid?"
+(test-assert "derivation-prerequisites and valid-derivation-input?"
   (let* ((a (build-expression->derivation %store "a" '(mkdir %output)))
          (b (build-expression->derivation %store "b" `(list ,(random-text))))
          (c (build-expression->derivation %store "c" `(mkdir %output)
                                           #:inputs `(("a" ,a) ("b" ,b)))))
-    (build-derivations %store (list a))
+    ;; Make sure both A and %BOOTSTRAP-GUILE are built (the latter could have
+    ;; be removed by tests/guix-gc.sh.)
+    (build-derivations %store
+                       (list a (package-derivation %store %bootstrap-guile)))
+
     (match (derivation-prerequisites c
                                      (cut valid-derivation-input? %store
                                           <>))
diff --git a/tests/gexp.scm b/tests/gexp.scm
index f81ef39860..7e14073fd4 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -109,6 +109,16 @@
             (eq? x local)))
          (equal? `(display ,intd) (gexp->sexp* exp)))))
 
+(test-assert "one plain file"
+  (let* ((file     (plain-file "hi" "Hello, world!"))
+         (exp      (gexp (display (ungexp file))))
+         (expected (add-text-to-store %store "hi" "Hello, world!")))
+    (and (gexp? exp)
+         (match (gexp-inputs exp)
+           (((x "out"))
+            (eq? x file)))
+         (equal? `(display ,expected) (gexp->sexp* exp)))))
+
 (test-assert "same input twice"
   (let ((exp (gexp (begin
                      (display (ungexp coreutils))
diff --git a/tests/guix-archive.sh b/tests/guix-archive.sh
index d4259b8677..8eacf89338 100644
--- a/tests/guix-archive.sh
+++ b/tests/guix-archive.sh
@@ -1,5 +1,5 @@
 # GNU Guix --- Functional package management for GNU
-# Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
 #
 # This file is part of GNU Guix.
 #
@@ -41,7 +41,6 @@ cmp "$archive" "$archive_alt"
 
 # Check the exit value and stderr upon import.
 guix archive --import < "$archive"
-guix archive --import < "$archive" 2>&1 | grep "import.*guile-bootstrap"
 
 if guix archive something-that-does-not-exist
 then false; else true; fi
diff --git a/tests/guix-build.sh b/tests/guix-build.sh
index 836c45e776..a72ce0911d 100644
--- a/tests/guix-build.sh
+++ b/tests/guix-build.sh
@@ -36,6 +36,88 @@ guix build -e '(@@ (gnu packages bootstrap) %bootstrap-guile)' |	\
 guix build hello -d |				\
     grep -e '-hello-[0-9\.]\+\.drv$'
 
+# Check --sources option with its arguments
+module_dir="t-guix-build-$$"
+mkdir "$module_dir"
+trap "rm -rf $module_dir" EXIT
+
+cat > "$module_dir/foo.scm"<<EOF
+(define-module (foo)
+  #:use-module (guix packages)
+  #:use-module (guix download)
+  #:use-module (guix build-system trivial))
+
+(define-public foo
+  (package
+    (name "foo")
+    (version "42")
+    (source (origin
+              (method url-fetch)
+              (uri "http://www.example.com/foo.tar.gz")
+              (sha256
+               (base32
+                "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"))))
+    (build-system trivial-build-system)
+    (inputs
+     (quasiquote (("bar" ,bar))))
+    (home-page "www.example.com")
+    (synopsis "Dummy package")
+    (description "foo is a dummy package for testing.")
+    (license #f)))
+
+(define-public bar
+  (package
+    (name "bar")
+    (version "9001")
+    (source (origin
+              (method url-fetch)
+              (uri "http://www.example.com/bar.tar.gz")
+              (sha256
+               (base32
+                "yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy"))))
+    (build-system trivial-build-system)
+    (inputs
+     (quasiquote
+      (("data" ,(origin
+                 (method url-fetch)
+                 (uri "http://www.example.com/bar.dat")
+                 (sha256
+                  (base32
+                   "zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz")))))))
+    (home-page "www.example.com")
+    (synopsis "Dummy package")
+    (description "bar is a dummy package for testing.")
+    (license #f)))
+EOF
+
+GUIX_PACKAGE_PATH="$module_dir"
+export GUIX_PACKAGE_PATH
+
+# foo.tar.gz
+guix build -d -S foo
+guix build -d -S foo | grep -e 'foo\.tar\.gz'
+
+guix build -d --sources=package foo
+guix build -d --sources=package foo | grep -e 'foo\.tar\.gz'
+
+# bar.tar.gz and bar.dat
+guix build -d --sources bar
+test `guix build -d --sources bar \
+      | grep -e 'bar\.tar\.gz' -e 'bar\.dat' \
+      | wc -l` -eq 2
+
+# bar.tar.gz and bar.dat
+guix build -d --sources=all bar
+test `guix build -d --sources bar \
+      | grep -e 'bar\.tar\.gz' -e 'bar\.dat' \
+      | wc -l` -eq 2
+
+# Should include foo.tar.gz, bar.tar.gz, and bar.dat
+guix build -d --sources=transitive foo
+test `guix build -d --sources=transitive foo \
+      | grep -e 'foo\.tar\.gz' -e 'bar\.tar\.gz' -e 'bar\.dat' \
+      | wc -l` -eq 3
+
 # Should all return valid log files.
 drv="`guix build -d -e '(@@ (gnu packages bootstrap) %bootstrap-guile)'`"
 out="`guix build -e '(@@ (gnu packages bootstrap) %bootstrap-guile)'`"
diff --git a/tests/guix-gc.sh b/tests/guix-gc.sh
index eac9d82e89..c1eb66cef5 100644
--- a/tests/guix-gc.sh
+++ b/tests/guix-gc.sh
@@ -64,3 +64,23 @@ guix gc -C 1KiB
 # Check trivial error cases.
 if guix gc --delete /dev/null;
 then false; else true; fi
+
+# Bug #19757
+out="`guix build guile-bootstrap`"
+test -d "$out"
+
+guix gc --delete "$out"
+
+! test -d "$out"
+
+out="`guix build guile-bootstrap`"
+test -d "$out"
+
+guix gc --delete "$out/"
+
+! test -d "$out"
+
+out="`guix build guile-bootstrap`"
+test -d "$out"
+
+guix gc --delete "$out/bin/guile"
diff --git a/tests/guix-package-net.sh b/tests/guix-package-net.sh
index cf3233bee2..14222cfd25 100644
--- a/tests/guix-package-net.sh
+++ b/tests/guix-package-net.sh
@@ -147,7 +147,7 @@ test "`readlink_base "$profile"`" = "$profile-2-link"
 
 # Make sure LIBRARY_PATH gets listed by `--search-paths'.
 guix package --bootstrap -p "$profile" -i guile-bootstrap -i gcc-bootstrap
-guix package --search-paths -p "$profile" | grep LIBRARY_PATH
+guix package -p "$profile" --search-paths | grep LIBRARY_PATH
 
 # Roll back so we can delete #3 below.
 guix package -p "$profile" --switch-generation=2
diff --git a/tests/guix-package.sh b/tests/guix-package.sh
index a732110d5c..b361b1ba00 100644
--- a/tests/guix-package.sh
+++ b/tests/guix-package.sh
@@ -52,8 +52,13 @@ test -L "$profile" && test -L "$profile-1-link"
 test -f "$profile/bin/guile"
 
 # No search path env. var. here.
-guix package --search-paths -p "$profile"
-test "`guix package --search-paths -p "$profile" | wc -l`" = 0
+guix package -p "$profile" --search-paths
+guix package -p "$profile" --search-paths | grep '^export PATH='
+test "`guix package -p "$profile" --search-paths | wc -l`" = 1  # $PATH
+( set -e; set -x;						\
+  eval `guix package --search-paths=prefix -p "$PWD/$profile"`;	\
+  test "`type -P guile`" = "$PWD/$profile/bin/guile" ;		\
+  type -P rm )
 
 # Exit with 1 when a generation does not exist.
 if guix package -p "$profile" --delete-generations=42;
@@ -237,3 +242,31 @@ export GUIX_BUILD_OPTIONS
 available2="`guix package -A | sort`"
 test "$available2" = "$available"
 guix package -I
+
+unset GUIX_BUILD_OPTIONS
+
+# Applying a manifest file.
+cat > "$module_dir/manifest.scm"<<EOF
+(use-package-modules bootstrap)
+
+(packages->manifest (list %bootstrap-guile))
+EOF
+guix package --bootstrap -m "$module_dir/manifest.scm"
+guix package -I | grep guile
+test `guix package -I | wc -l` -eq 1
+
+# Error reporting.
+cat > "$module_dir/manifest.scm"<<EOF
+(use-package-modules bootstrap)
+(packages->manifest
+  (list %bootstrap-guile
+        wonderful-package-that-does-not-exist))
+EOF
+if guix package --bootstrap -n -m "$module_dir/manifest.scm" \
+	2> "$module_dir/stderr"
+then false
+else
+    cat "$module_dir/stderr"
+    grep "manifest.scm:[1-3]:.*[Uu]nbound variable.*wonderful-package" \
+	 "$module_dir/stderr"
+fi
diff --git a/tests/guix-register.sh b/tests/guix-register.sh
index 7084ac6b8c..360cf55979 100644
--- a/tests/guix-register.sh
+++ b/tests/guix-register.sh
@@ -56,15 +56,14 @@ guile -c "
   (exit (= (stat:ino (stat \"$new_file\"))
            (stat:ino (stat \"$new_file2\"))))"
 
-# Make sure both are valid, and delete them.
+# Make sure both are valid.
 guile -c "
    (use-modules (guix store))
    (define s (open-connection))
    (exit (and (valid-path? s \"$new_file\")
               (valid-path? s \"$new_file2\")
               (null? (references s \"$new_file\"))
-              (null? (references s \"$new_file2\"))
-              (pair? (delete-paths s (list \"$new_file\" \"$new_file2\")))))"
+              (null? (references s \"$new_file2\"))))"
 
 
 #
@@ -98,6 +97,33 @@ guix-register --prefix "$new_store" "$closure"
 guix-register -p "$new_store" \
     --state-directory "$new_store/chbouib" "$closure"
 
+# Register duplicate files.
+cp "$new_file" "$new_file2" "$new_store_dir"
+guix-register -p "$new_store" <<EOF
+$new_file
+
+0
+EOF
+guix-register -p "$new_store" <<EOF
+$new_file2
+
+0
+EOF
+
+copied_duplicate1="$new_store_dir/`basename $new_file`"
+copied_duplicate2="$new_store_dir/`basename $new_file2`"
+
+# Make sure there is indeed deduplication under $new_store and that there are
+# no cross-store hard links.
+guile -c "
+  (exit (and (= (stat:ino (stat \"$copied_duplicate1\"))
+                (stat:ino (stat \"$copied_duplicate2\")))
+             (not (= (stat:ino (stat \"$new_file\"))
+                     (stat:ino (stat \"$copied_duplicate1\"))))))"
+
+# Delete them.
+guix gc -d "$new_file" "$new_file2"
+
 # Now make sure this is recognized as valid.
 
 ls -R "$new_store"
@@ -107,12 +133,13 @@ do
     NIX_STATE_DIR="$new_store$state_dir"
     NIX_LOG_DIR="$new_store$state_dir/log/guix"
     NIX_DB_DIR="$new_store$state_dir/db"
+    GUIX_DAEMON_SOCKET="$NIX_STATE_DIR/daemon-socket/socket"
 
     export NIX_IGNORE_SYMLINK_STORE NIX_STORE_DIR NIX_STATE_DIR	\
-	NIX_LOG_DIR NIX_DB_DIR
+	   NIX_LOG_DIR NIX_DB_DIR GUIX_DAEMON_SOCKET
 
     # Check whether we overflow the limitation on local socket name lengths.
-    if [ `echo "$NIX_STATE_DIR/daemon-socket/socket" | wc -c` -ge 108 ]
+    if [ `echo "$GUIX_DAEMON_SOCKET" | wc -c` -ge 108 ]
     then
 	# Mark the test as skipped even though we already did some work so
 	# that the remainder is not silently skipped.
@@ -130,9 +157,12 @@ do
     # that name in a 'valid-path?' query because 'assertStorePath' would kill
     # us because of the wrong prefix.  So we just list dead paths instead.
     guile -c "
-      (use-modules (guix store))
-      (define s (open-connection))
-      (exit (equal? (list \"$copied\") (dead-paths s)))"
+      (use-modules (guix store) (srfi srfi-1))
+      (define s (open-connection \"$GUIX_DAEMON_SOCKET\"))
+      (exit (lset= string=?
+                   (pk 1 (list \"$copied\" \"$copied_duplicate1\"
+                               \"$copied_duplicate2\"))
+                   (pk 2 (dead-paths s))))"
 
     # Kill the daemon so we can access the database below (otherwise we may
     # get "database is locked" errors.)
diff --git a/tests/guix-system.sh b/tests/guix-system.sh
index 1b77d1a0db..4289db2390 100644
--- a/tests/guix-system.sh
+++ b/tests/guix-system.sh
@@ -45,6 +45,32 @@ else
 fi
 
 
+# Reporting of unbound variables.
+
+cat > "$tmpfile" <<EOF
+(use-modules (gnu))                                   ; 1
+(use-service-modules networking)                      ; 2
+
+(operating-system                                     ; 4
+  (host-name "antelope")                              ; 5
+  (timezone "Europe/Paris")                           ; 6
+  (locale "en_US.UTF-8")                              ; 7
+
+  (bootloader (GRUB-config (device "/dev/sdX")))      ; 9
+  (file-systems (cons (file-system
+                        (device "root")
+                        (title 'label)
+                        (mount-point "/")
+                        (type "ext4"))
+                      %base-file-systems)))
+EOF
+
+if guix system build "$tmpfile" -n 2> "$errorfile"
+then false
+else
+    grep "$tmpfile:9:.*[Uu]nbound variable.*GRUB-config" "$errorfile"
+fi
+
 # Reporting of duplicate service identifiers.
 
 cat > "$tmpfile" <<EOF
@@ -76,3 +102,42 @@ then
 else
     grep "service 'networking'.*more than once" "$errorfile"
 fi
+
+make_user_config ()
+{
+    cat > "$tmpfile" <<EOF
+(use-modules (gnu))
+(use-service-modules networking)
+
+(operating-system
+  (host-name "antelope")
+  (timezone "Europe/Paris")
+  (locale "en_US.UTF-8")
+
+  (bootloader (grub-configuration (device "/dev/sdX")))
+  (file-systems (cons (file-system
+                        (device "root")
+                        (title 'label)
+                        (mount-point "/")
+                        (type "ext4"))
+                      %base-file-systems))
+  (users (list (user-account
+                 (name "dave")
+                 (home-directory "/home/dave")
+                 (group "$1")
+                 (supplementary-groups '("$2"))))))
+EOF
+}
+
+make_user_config "users" "wheel"
+guix system build "$tmpfile" -n       # succeeds
+
+make_user_config "group-that-does-not-exist" "users"
+if guix system build "$tmpfile" -n 2> "$errorfile"
+then false
+else grep "primary group.*group-that-does-not-exist.*undeclared" "$errorfile"; fi
+
+make_user_config "users" "group-that-does-not-exist"
+if guix system build "$tmpfile" -n 2> "$errorfile"
+then false
+else grep "supplementary group.*group-that-does-not-exist.*undeclared" "$errorfile"; fi
diff --git a/tests/hackage.scm b/tests/hackage.scm
index 23b854caa4..229bee35ea 100644
--- a/tests/hackage.scm
+++ b/tests/hackage.scm
@@ -17,6 +17,7 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (test-hackage)
+  #:use-module (guix import cabal)
   #:use-module (guix import hackage)
   #:use-module (guix tests)
   #:use-module (srfi srfi-64)
@@ -35,44 +36,44 @@ executable cabal
     mtl        >= 2.0      && < 3
 ")
 
-;; Use TABs to indent lines and to separate keys from value.
 (define test-cabal-2
-  "name:	foo
-version:	1.0.0
-homepage:	http://test.org
-synopsis:	synopsis
-description:	description
-license:	BSD3
-executable cabal
-	build-depends:	HTTP       >= 4000.2.5 && < 4000.3,
-		mtl        >= 2.0      && < 3
-")
-
-;; Use indentation with comma as found, e.g., in 'haddock-api'.
-(define test-cabal-3
   "name: foo
 version: 1.0.0
 homepage: http://test.org
 synopsis: synopsis
 description: description
 license: BSD3
-executable cabal
-    build-depends:
-        HTTP       >= 4000.2.5 && < 4000.3
-      , mtl        >= 2.0      && < 3
+executable cabal {
+build-depends:
+  HTTP       >= 4000.2.5 && < 4000.3,
+  mtl        >= 2.0      && < 3
+}
 ")
 
-(define test-cond-1
-  "(os(darwin) || !(flag(debug))) && flag(cips)")
-
-(define read-cabal
-  (@@ (guix import hackage) read-cabal))
-
-(define eval-cabal-keywords
-  (@@ (guix import hackage) eval-cabal-keywords))
-
-(define conditional->sexp-like
-  (@@ (guix import hackage) conditional->sexp-like))
+;; A fragment of a real Cabal file with minor modification to check precedence
+;; of 'and' over 'or'.
+(define test-read-cabal-1
+  "name: test-me
+library
+  -- Choose which library versions to use.
+  if flag(base4point8)
+    Build-depends: base >= 4.8 && < 5
+  else
+    if flag(base4)
+      Build-depends: base >= 4 && < 4.8
+    else
+      if flag(base3)
+        Build-depends: base >= 3 && < 4
+      else
+        Build-depends: base < 3
+  if flag(base4point8) || flag(base4) && flag(base3)
+    Build-depends: random
+  Build-depends: containers
+
+  -- Modules that are always built.
+  Exposed-Modules:
+    Test.QuickCheck.Exception
+")
 
 (test-begin "hackage")
 
@@ -115,18 +116,25 @@ executable cabal
 (test-assert "hackage->guix-package test 2"
   (eval-test-with-cabal test-cabal-2))
 
-(test-assert "hackage->guix-package test 3"
-  (eval-test-with-cabal test-cabal-3))
-
-(test-assert "conditional->sexp-like"
-  (match
-    (eval-cabal-keywords
-     (conditional->sexp-like test-cond-1)
-     '(("debug" . "False")))
-    (('and ('or ('string-match "darwin" ('%current-system)) ('not '#f)) '#t)
+(test-assert "read-cabal test 1"
+  (match (call-with-input-string test-read-cabal-1 read-cabal)
+    ((("name" ("test-me"))
+      ('section 'library
+               (('if ('flag "base4point8")
+                    (("build-depends" ("base >= 4.8 && < 5")))
+                    (('if ('flag "base4")
+                         (("build-depends" ("base >= 4 && < 4.8")))
+                         (('if ('flag "base3")
+                              (("build-depends" ("base >= 3 && < 4")))
+                              (("build-depends" ("base < 3"))))))))
+                ('if ('or ('flag "base4point8")
+                          ('and ('flag "base4") ('flag "base3")))
+                    (("build-depends" ("random")))
+                    ())
+                ("build-depends" ("containers"))
+                ("exposed-modules" ("Test.QuickCheck.Exception")))))
      #t)
-    (x
-     (pk 'fail x #f))))
+    (x (pk 'fail x #f))))
 
 (test-end "hackage")
 
diff --git a/tests/monads.scm b/tests/monads.scm
index 57a8e66797..d3ef065f24 100644
--- a/tests/monads.scm
+++ b/tests/monads.scm
@@ -103,6 +103,19 @@
          %monads
          %monad-run))
 
+(test-assert ">>= with more than two arguments"
+  (every (lambda (monad run)
+           (let ((1+ (lift1 1+ monad))
+                 (2* (lift1 (cut * 2 <>) monad)))
+             (with-monad monad
+               (let ((number (random 777)))
+                 (= (run (>>= (return number)
+                              1+ 1+ 1+
+                              2* 2* 2*))
+                    (* 8 (+ number 3)))))))
+         %monads
+         %monad-run))
+
 (test-assert "mbegin"
   (every (lambda (monad run)
            (with-monad monad
@@ -163,7 +176,7 @@
 (test-assert "mapm"
   (every (lambda (monad run)
            (with-monad monad
-             (equal? (run (mapm monad (lift1 1+ monad) (map return (iota 10))))
+             (equal? (run (mapm monad (lift1 1+ monad) (iota 10)))
                      (map 1+ (iota 10)))))
          %monads
          %monad-run))
@@ -202,11 +215,12 @@
 (test-assert "anym"
   (every (lambda (monad run)
            (eq? (run (with-monad monad
-                       (let ((lst (list (return 1) (return 2) (return 3))))
-                         (anym monad
-                               (lambda (x)
-                                 (and (odd? x) 'odd!))
-                               lst))))
+                       (anym monad
+                             (lift1 (lambda (x)
+                                      (and (odd? x) 'odd!))
+                                    monad)
+                             (append (make-list 1000 0)
+                                     (list 1 2)))))
                 'odd!))
          %monads
          %monad-run))
diff --git a/tests/packages.scm b/tests/packages.scm
index 4e52813659..511ad78b6c 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -155,6 +155,36 @@
           (package-transitive-supported-systems d)
           (package-transitive-supported-systems e))))
 
+(let* ((o (dummy-origin))
+       (u (dummy-origin))
+       (i (dummy-origin))
+       (a (dummy-package "a"))
+       (b (dummy-package "b"
+            (inputs `(("a" ,a) ("i" ,i)))))
+       (c (package (inherit b) (source o)))
+       (d (dummy-package "d"
+            (build-system trivial-build-system)
+            (source u) (inputs `(("c" ,c))))))
+  (test-assert "package-direct-sources, no source"
+    (null? (package-direct-sources a)))
+  (test-equal "package-direct-sources, #f source"
+    (list i)
+    (package-direct-sources b))
+  (test-equal "package-direct-sources, not input source"
+    (list u)
+    (package-direct-sources d))
+  (test-assert "package-direct-sources"
+    (let ((s (package-direct-sources c)))
+      (and (= (length (pk 's-sources s)) 2)
+           (member o s)
+           (member i s))))
+  (test-assert "package-transitive-sources"
+    (let ((s (package-transitive-sources d)))
+      (and (= (length (pk 'd-sources s)) 3)
+           (member o s)
+           (member i s)
+           (member u s)))))
+
 (test-equal "package-transitive-supported-systems, implicit inputs"
   %supported-systems
 
diff --git a/tests/profiles.scm b/tests/profiles.scm
index 54fbaea864..cc9a822cee 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -24,10 +24,14 @@
   #:use-module (guix monads)
   #:use-module (guix packages)
   #:use-module (guix derivations)
+  #:use-module (guix build-system trivial)
   #:use-module (gnu packages bootstrap)
   #:use-module ((gnu packages base) #:prefix packages:)
+  #:use-module ((gnu packages guile) #:prefix packages:)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
+  #:use-module (ice-9 popen)
+  #:use-module (rnrs io ports)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-64))
 
@@ -198,6 +202,109 @@
                                        #:hooks '())))
     (return (derivation-inputs drv))))
 
+(test-assertm "profile-manifest, search-paths"
+  (mlet* %store-monad
+      ((guile ->   (package
+                     (inherit %bootstrap-guile)
+                     (native-search-paths
+                      (package-native-search-paths packages:guile-2.0))))
+       (entry ->   (package->manifest-entry guile))
+       (drv        (profile-derivation (manifest (list entry))
+                                       #:hooks '()))
+       (profile -> (derivation->output-path drv)))
+    (mbegin %store-monad
+      (built-derivations (list drv))
+
+      ;; Read the manifest back and make sure search paths are preserved.
+      (let ((manifest (profile-manifest profile)))
+        (match (manifest-entries manifest)
+          ((result)
+           (return (equal? (manifest-entry-search-paths result)
+                           (manifest-entry-search-paths entry)
+                           (package-native-search-paths
+                            packages:guile-2.0)))))))))
+
+(test-assertm "etc/profile"
+  ;; Make sure we get an 'etc/profile' file that at least defines $PATH.
+  (mlet* %store-monad
+      ((guile ->   (package
+                     (inherit %bootstrap-guile)
+                     (native-search-paths
+                      (package-native-search-paths packages:guile-2.0))))
+       (entry ->   (package->manifest-entry guile))
+       (drv        (profile-derivation (manifest (list entry))
+                                       #:hooks '()))
+       (profile -> (derivation->output-path drv)))
+    (mbegin %store-monad
+      (built-derivations (list drv))
+      (let* ((pipe (open-input-pipe
+                    (string-append "unset GUIX_PROFILE; "
+                                   ;; 'source' is a Bashism; use '.' (dot).
+                                   ". " profile "/etc/profile; "
+                                   ;; Don't try to parse set(1) output because
+                                   ;; it differs among shells; just use echo.
+                                   "echo $PATH")))
+             (path (get-string-all pipe)))
+        (return
+         (and (zero? (close-pipe pipe))
+              (string-contains path (string-append profile "/bin"))))))))
+
+(test-assertm "etc/profile when etc/ already exists"
+  ;; Here 'union-build' makes the profile's etc/ a symlink to the package's
+  ;; etc/ directory, which makes it read-only.  Make sure the profile build
+  ;; handles that.
+  (mlet* %store-monad
+      ((thing ->   (dummy-package "dummy"
+                     (build-system trivial-build-system)
+                     (arguments
+                      `(#:guile ,%bootstrap-guile
+                        #:builder
+                        (let ((out (assoc-ref %outputs "out")))
+                          (mkdir out)
+                          (mkdir (string-append out "/etc"))
+                          (call-with-output-file (string-append out "/etc/foo")
+                            (lambda (port)
+                              (display "foo!" port))))))))
+       (entry ->   (package->manifest-entry thing))
+       (drv        (profile-derivation (manifest (list entry))
+                                       #:hooks '()))
+       (profile -> (derivation->output-path drv)))
+    (mbegin %store-monad
+      (built-derivations (list drv))
+      (return (and (file-exists? (string-append profile "/etc/profile"))
+                   (string=? (call-with-input-file
+                                 (string-append profile "/etc/foo")
+                               get-string-all)
+                             "foo!"))))))
+
+(test-assertm "etc/profile when etc/ is a symlink"
+  ;; When etc/ is a symlink, the unsymlink code in 0.8.2 would fail
+  ;; gracelessly because 'scandir' would return #f.
+  (mlet* %store-monad
+      ((thing ->   (dummy-package "dummy"
+                     (build-system trivial-build-system)
+                     (arguments
+                      `(#:guile ,%bootstrap-guile
+                        #:builder
+                        (let ((out (assoc-ref %outputs "out")))
+                          (mkdir out)
+                          (mkdir (string-append out "/foo"))
+                          (symlink "foo" (string-append out "/etc"))
+                          (call-with-output-file (string-append out "/etc/bar")
+                            (lambda (port)
+                              (display "foo!" port))))))))
+       (entry ->   (package->manifest-entry thing))
+       (drv        (profile-derivation (manifest (list entry))
+                                       #:hooks '()))
+       (profile -> (derivation->output-path drv)))
+    (mbegin %store-monad
+      (built-derivations (list drv))
+      (return (and (file-exists? (string-append profile "/etc/profile"))
+                   (string=? (call-with-input-file
+                                 (string-append profile "/etc/bar")
+                               get-string-all)
+                             "foo!"))))))
+
 (test-end "profiles")
 
 
diff --git a/tests/store.scm b/tests/store.scm
index eeceed45c1..faa924fce9 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -600,6 +600,60 @@
            (null? (valid-derivers %store file))
            (null? (referrers %store file))))))
 
+(test-assert "verify-store"
+  (let* ((text  (random-text))
+         (file1 (add-text-to-store %store "foo" text))
+         (file2 (add-text-to-store %store "bar" (random-text)
+                                   (list file1))))
+    (and (pk 'verify1 (verify-store %store))    ;hopefully OK ;
+         (begin
+           (delete-file file1)
+           (not (pk 'verify2 (verify-store %store)))) ;bad! ;
+         (begin
+           ;; Using 'add-text-to-store' here wouldn't work: It would succeed ;
+           ;; without actually creating the file. ;
+           (call-with-output-file file1
+             (lambda (port)
+               (display text port)))
+           (pk 'verify3 (verify-store %store)))))) ;OK again
+
+(test-assert "verify-store + check-contents"
+  ;; XXX: This test is I/O intensive.
+  (with-store s
+    (let* ((text (random-text))
+           (drv  (build-expression->derivation
+                  s "corrupt"
+                  `(let ((out (assoc-ref %outputs "out")))
+                     (call-with-output-file out
+                       (lambda (port)
+                         (display ,text port)))
+                     #t)
+                  #:guile-for-build
+                  (package-derivation s %bootstrap-guile (%current-system))))
+           (file (derivation->output-path drv)))
+      (with-derivation-substitute drv text
+        (and (build-derivations s (list drv))
+             (verify-store s #:check-contents? #t) ;should be OK
+             (begin
+               (chmod file #o644)
+               (call-with-output-file file
+                 (lambda (port)
+                   (display "corrupt!" port)))
+               #t)
+
+             ;; Make sure the corruption is detected.  We don't test repairing
+             ;; because only "trusted" users are allowed to do it, but we
+             ;; don't expose that notion of trusted users that nix-daemon
+             ;; supports because it seems dubious and redundant with what the
+             ;; OS provides (in Nix "trusted" users have additional
+             ;; privileges, such as overriding the set of substitute URLs, but
+             ;; we instead want to allow anyone to modify them, provided
+             ;; substitutes are signed by a root-approved key.)
+             (not (verify-store s #:check-contents? #t))
+
+             ;; Delete the corrupt item to leave the store in a clean state.
+             (delete-paths s (list file)))))))
+
 (test-equal "store-lower"
   "Lowered."
   (let* ((add  (store-lower text-file))
diff --git a/tests/utils.scm b/tests/utils.scm
index a662c9a8d3..115868c857 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -21,6 +21,7 @@
   #:use-module ((guix config) #:select (%gzip))
   #:use-module (guix utils)
   #:use-module ((guix store) #:select (%store-prefix store-path-package-name))
+  #:use-module ((guix search-paths) #:select (string-tokenize*))
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-64)