Merge branch 'master' into core-updates

6 files changed, 91 insertions, 12 deletions

diff --git a/tests/gexp.scm b/tests/gexp.scm
index 6d4885e44e..bdea4b8563 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -224,7 +224,7 @@
       (return (string=? system (derivation-system drv))))))
 
 (define shebang
-  (string-append (derivation->output-path guile-for-build)
+  (string-append "#!" (derivation->output-path guile-for-build)
                  "/bin/guile --no-auto-compile"))
 
 ;; If we're going to hit the silly shebang limit (128 chars on Linux-based
diff --git a/tests/guix-package.sh b/tests/guix-package.sh
index 4d75955411..ce123105bf 100644
--- a/tests/guix-package.sh
+++ b/tests/guix-package.sh
@@ -79,13 +79,6 @@ then
 
     test "`guix package -p "$profile" -I 'g.*e' | cut -f1`" = "guile-bootstrap"
 
-    # Search.
-    LC_MESSAGES=C
-    export LC_MESSAGES
-    test "`guix package -s "An example GNU package" | grep ^name:`" = \
-        "name: hello"
-    test -z "`guix package -s "n0t4r341p4ck4g3"`"
-
     # List generations.
     test "`guix package -p "$profile" -l | cut -f1 | grep guile | head -n1`" \
         = "  guile-bootstrap"
@@ -176,6 +169,22 @@ then false; else true; fi
 # Check whether `--list-available' returns something sensible.
 guix package -p "$profile" -A 'gui.*e' | grep guile
 
+# Check whether `--show' returns something sensible.
+guix package --show=guile | grep "^name: guile"
+
+# Ensure `--show' doesn't fail for packages with non-package inputs.
+guix package --show=texlive
+
+# Search.
+LC_MESSAGES=C
+export LC_MESSAGES
+test "`guix package -s "An example GNU package" | grep ^name:`" = \
+    "name: hello"
+test -z "`guix package -s "n0t4r341p4ck4g3"`"
+
+# Make sure `--search' can display all the packages.
+guix package --search="" > /dev/null
+
 # There's no generation older than 12 months, so the following command should
 # have no effect.
 generation="`readlink_base "$profile"`"
diff --git a/tests/guix-register.sh b/tests/guix-register.sh
index e258ec1244..3f261d7bef 100644
--- a/tests/guix-register.sh
+++ b/tests/guix-register.sh
@@ -86,7 +86,7 @@ guix-register -p "$new_store" \
 # Now make sure this is recognized as valid.
 
 ls -R "$new_store"
-for state_dir in "$new_store$localstatedir/guix" "$new_store/chbouib"
+for state_dir in "$localstatedir/guix" "/chbouib"
 do
     NIX_STORE_DIR="$new_store_dir"
     NIX_STATE_DIR="$new_store$state_dir"
diff --git a/tests/monads.scm b/tests/monads.scm
index ac19d33f93..ea3e4006ab 100644
--- a/tests/monads.scm
+++ b/tests/monads.scm
@@ -108,6 +108,16 @@
                       guile)))
     #:guile-for-build (package-derivation %store %bootstrap-guile)))
 
+(test-assert "interned-file"
+  (run-with-store %store
+    (mlet* %store-monad ((file -> (search-path %load-path "guix.scm"))
+                         (a       (interned-file file))
+                         (b       (interned-file file "b")))
+      (return (equal? (call-with-input-file file get-string-all)
+                      (call-with-input-file a get-string-all)
+                      (call-with-input-file b get-string-all))))
+    #:guile-for-build (package-derivation %store %bootstrap-guile)))
+
 (define derivation-expression
   (@@ (guix monads) derivation-expression))
 
diff --git a/tests/profiles.scm b/tests/profiles.scm
index 8ead6e6968..d405f6453e 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -18,11 +18,25 @@
 
 (define-module (test-profiles)
   #:use-module (guix profiles)
+  #:use-module (guix store)
+  #:use-module (guix monads)
+  #:use-module (guix packages)
+  #:use-module (guix derivations)
+  #:use-module (gnu packages bootstrap)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-64))
 
 ;; Test the (guix profile) module.
 
+(define %store
+  (open-connection))
+
+(define guile-for-build
+  (package-derivation %store %bootstrap-guile))
+
+;; Make it the default.
+(%guile-for-build guile-for-build)
+
 
 ;; Example manifest entries.
 
@@ -30,7 +44,7 @@
   (manifest-entry
     (name "guile")
     (version "2.0.9")
-    (path "/gnu/store/...")
+    (item "/gnu/store/...")
     (output "out")))
 
 (define guile-2.0.9:debug
@@ -87,6 +101,19 @@
             (null? (manifest-entries m3))
             (null? (manifest-entries m4)))))))
 
+(test-assert "profile-derivation"
+  (run-with-store %store
+    (mlet* %store-monad
+        ((entry ->   (package->manifest-entry %bootstrap-guile))
+         (guile      (package->derivation %bootstrap-guile))
+         (drv        (profile-derivation (manifest (list entry))))
+         (profile -> (derivation->output-path drv))
+         (bindir ->  (string-append profile "/bin"))
+         (_          (built-derivations (list drv))))
+      (return (and (file-exists? (string-append bindir "/guile"))
+                   (string=? (dirname (readlink bindir))
+                             (derivation->output-path guile)))))))
+
 (test-end "profiles")
 
 
diff --git a/tests/utils.scm b/tests/utils.scm
index 8ad399f75c..611867ca09 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -25,7 +26,8 @@
   #:use-module (srfi srfi-64)
   #:use-module (rnrs bytevectors)
   #:use-module (rnrs io ports)
-  #:use-module (ice-9 match))
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 vlist))
 
 (define temp-file
   (string-append "t-utils-" (number->string (getpid))))
@@ -118,6 +120,37 @@
                '(0 1 2 3)))
     list))
 
+(let* ((tree (alist->vhash
+              '((0 2 3) (1 3 4) (2) (3 5 6) (4 6) (5) (6))
+              hashq))
+       (add-one (lambda (_ r) (1+ r)))
+       (tree-lookup (lambda (n) (cdr (vhash-assq n tree)))))
+  (test-equal "fold-tree, single root"
+    5 (fold-tree add-one 0 tree-lookup '(0)))
+  (test-equal "fold-tree, two roots"
+    7 (fold-tree add-one 0 tree-lookup '(0 1)))
+  (test-equal "fold-tree, sum"
+    16 (fold-tree + 0 tree-lookup '(0)))
+  (test-equal "fold-tree, internal"
+    18 (fold-tree + 0 tree-lookup '(3 4)))
+  (test-equal "fold-tree, cons"
+    '(1 3 4 5 6)
+    (sort (fold-tree cons '() tree-lookup '(1)) <))
+  (test-equal "fold-tree, overlapping paths"
+    '(1 3 4 5 6)
+    (sort (fold-tree cons '() tree-lookup '(1 4)) <))
+  (test-equal "fold-tree, cons, two roots"
+    '(0 2 3 4 5 6)
+    (sort (fold-tree cons '() tree-lookup '(0 4)) <))
+  (test-equal "fold-tree-leaves, single root"
+    2 (fold-tree-leaves add-one 0 tree-lookup '(1)))
+  (test-equal "fold-tree-leaves, single root, sum"
+    11 (fold-tree-leaves + 0 tree-lookup '(1)))
+  (test-equal "fold-tree-leaves, two roots"
+    3 (fold-tree-leaves add-one 0 tree-lookup '(0 1)))
+  (test-equal "fold-tree-leaves, two roots, sum"
+    13 (fold-tree-leaves + 0 tree-lookup '(0 1))))
+
 (test-assert "filtered-port, file"
   (let* ((file  (search-path %load-path "guix.scm"))
          (input (open-file file "r0b")))