Merge branch 'master' into core-updates

Conflicts:
	guix/packages.scm

4 files changed, 188 insertions, 11 deletions

diff --git a/tests/derivations.scm b/tests/derivations.scm
index 1b32ab5ffd..273db22765 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -125,7 +125,7 @@
                               #:env-vars '(("HOME" . "/homeless")
                                            ("zzz"  . "Z!")
                                            ("AAA"  . "A!"))
-                              #:inputs `((,builder))))
+                              #:inputs `((,%bash) (,builder))))
          (succeeded?
           (build-derivations %store (list drv))))
     (and succeeded?
@@ -149,7 +149,8 @@
                                  ;; builder.
                                  #:env-vars `(("in" . ,input*))
 
-                                 #:inputs `((,builder)
+                                 #:inputs `((,%bash)
+                                            (,builder)
                                             (,input))))) ; ← local file name
     (and (build-derivations %store (list drv))
          ;; Note: we can't compare the files because the above trick alters
@@ -211,11 +212,11 @@
          (final1     (derivation %store "final"
                                  %bash `(,builder3)
                                  #:env-vars `(("in" . ,fixed-out))
-                                 #:inputs `((,builder3) (,fixed1))))
+                                 #:inputs `((,%bash) (,builder3) (,fixed1))))
          (final2     (derivation %store "final"
                                  %bash `(,builder3)
                                  #:env-vars `(("in" . ,fixed-out))
-                                 #:inputs `((,builder3) (,fixed2))))
+                                 #:inputs `((,%bash) (,builder3) (,fixed2))))
          (succeeded? (build-derivations %store
                                         (list final1 final2))))
     (and succeeded?
@@ -231,7 +232,7 @@
                                  #:env-vars '(("HOME" . "/homeless")
                                               ("zzz"  . "Z!")
                                               ("AAA"  . "A!"))
-                                 #:inputs `((,builder))
+                                 #:inputs `((,%bash) (,builder))
                                  #:outputs '("out" "second")))
          (succeeded? (build-derivations %store (list drv))))
     (and succeeded?
@@ -251,7 +252,7 @@
                                         '()))
          (drv        (derivation %store "fixed"
                                  %bash `(,builder)
-                                 #:inputs `((,builder))
+                                 #:inputs `((,%bash) (,builder))
                                  #:outputs '("out" "AAA")))
          (succeeded? (build-derivations %store (list drv))))
     (and succeeded?
@@ -285,7 +286,7 @@
                                         '()))
          (mdrv       (derivation %store "multiple-output"
                                  %bash `(,builder1)
-                                 #:inputs `((,builder1))
+                                 #:inputs `((,%bash) (,builder1))
                                  #:outputs '("out" "two")))
          (builder2   (add-text-to-store %store "my-mo-user-builder.sh"
                                         "read x < $one;
@@ -300,7 +301,8 @@
                                               ("two"
                                                . ,(derivation->output-path
                                                    mdrv "two")))
-                                 #:inputs `((,builder2)
+                                 #:inputs `((,%bash)
+                                            (,builder2)
                                             ;; two occurrences of MDRV:
                                             (,mdrv)
                                             (,mdrv "two")))))
@@ -417,8 +419,8 @@
   (let* ((store      (let ((s (open-connection)))
                        (set-build-options s #:max-silent-time 1)
                        s))
-         (builder    '(sleep 100))
-         (drv        (build-expression->derivation %store "silent"
+         (builder    '(begin (sleep 100) (mkdir %output) #t))
+         (drv        (build-expression->derivation store "silent"
                                                    (%current-system)
                                                    builder '()))
          (out-path   (derivation->output-path drv)))
@@ -426,7 +428,8 @@
                (and (string-contains (nix-protocol-error-message c)
                                      "failed")
                     (not (valid-path? store out-path)))))
-      (build-derivations %store (list drv)))))
+      (build-derivations store (list drv))
+      #f)))
 
 (test-assert "build-expression->derivation and derivation-prerequisites-to-build"
   (let ((drv (build-expression->derivation %store "fail" (%current-system)
diff --git a/tests/packages.scm b/tests/packages.scm
index e0cf4ee001..803cabb061 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -20,6 +20,7 @@
 (define-module (test-packages)
   #:use-module (guix store)
   #:use-module (guix utils)
+  #:use-module (guix hash)
   #:use-module (guix derivations)
   #:use-module (guix packages)
   #:use-module (guix build-system)
@@ -121,6 +122,65 @@
                                              (package-source package))))
     (string=? file source)))
 
+(test-equal "package-source-derivation, snippet"
+  "OK"
+  (let* ((file   (search-bootstrap-binary "guile-2.0.7.tar.xz"
+                                          (%current-system)))
+         (sha256 (call-with-input-file file port-sha256))
+         (fetch  (lambda* (store url hash-algo hash
+                           #:optional name #:key system)
+                   (pk 'fetch url hash-algo hash name system)
+                   (add-to-store store (basename url) #f "sha256" url)))
+         (source (bootstrap-origin
+                  (origin
+                    (method fetch)
+                    (uri file)
+                    (sha256 sha256)
+                    (patch-inputs
+                     `(("tar" ,%bootstrap-coreutils&co)
+                       ("xz" ,%bootstrap-coreutils&co)
+                       ("patch" ,%bootstrap-coreutils&co)))
+                    (patch-guile %bootstrap-guile)
+                    (modules '((guix build utils)))
+                    (imported-modules modules)
+                    (snippet '(begin
+                                ;; We end up in 'bin', because it's the first
+                                ;; directory, alphabetically.  Not a very good
+                                ;; example but hey.
+                                (chmod "." #o777)
+                                (symlink "guile" "guile-rocks")
+                                (copy-recursively "../share/guile/2.0/scripts"
+                                                  "scripts")
+
+                                ;; These variables must exist.
+                                (pk %build-inputs %outputs))))))
+         (package (package (inherit (dummy-package "with-snippet"))
+                    (source source)
+                    (build-system trivial-build-system)
+                    (inputs
+                     `(("tar" ,(search-bootstrap-binary "tar"
+                                                        (%current-system)))
+                       ("xz"  ,(search-bootstrap-binary "xz"
+                                                        (%current-system)))))
+                    (arguments
+                     `(#:guile ,%bootstrap-guile
+                       #:builder
+                       (let ((tar    (assoc-ref %build-inputs "tar"))
+                             (xz     (assoc-ref %build-inputs "xz"))
+                             (source (assoc-ref %build-inputs "source")))
+                         (and (zero? (system* tar "xvf" source
+                                              "--use-compress-program" xz))
+                              (string=? "guile" (readlink "bin/guile-rocks"))
+                              (file-exists? "bin/scripts/compile.scm")
+                              (let ((out (assoc-ref %outputs "out")))
+                                (call-with-output-file out
+                                  (lambda (p)
+                                    (display "OK" p))))))))))
+         (drv    (package-derivation %store package))
+         (out    (derivation->output-path drv)))
+    (and (build-derivations %store (list (pk 'snippet-drv drv)))
+         (call-with-input-file out get-string-all))))
+
 (test-assert "return value"
   (let ((drv (package-derivation %store (dummy-package "p"))))
     (and (derivation? drv)
diff --git a/tests/profiles.scm b/tests/profiles.scm
new file mode 100644
index 0000000000..8ead6e6968
--- /dev/null
+++ b/tests/profiles.scm
@@ -0,0 +1,97 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013 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-profiles)
+  #:use-module (guix profiles)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-64))
+
+;; Test the (guix profile) module.
+
+
+;; Example manifest entries.
+
+(define guile-2.0.9
+  (manifest-entry
+    (name "guile")
+    (version "2.0.9")
+    (path "/gnu/store/...")
+    (output "out")))
+
+(define guile-2.0.9:debug
+  (manifest-entry (inherit guile-2.0.9)
+    (output "debug")))
+
+
+(test-begin "profiles")
+
+(test-assert "manifest-installed?"
+  (let ((m (manifest (list guile-2.0.9 guile-2.0.9:debug))))
+    (and (manifest-installed? m (manifest-pattern (name "guile")))
+         (manifest-installed? m (manifest-pattern
+                                  (name "guile") (output "debug")))
+         (manifest-installed? m (manifest-pattern
+                                  (name "guile") (output "out")
+                                  (version "2.0.9")))
+         (not (manifest-installed?
+               m (manifest-pattern (name "guile") (version "1.8.8"))))
+         (not (manifest-installed?
+               m (manifest-pattern (name "guile") (output "foobar")))))))
+
+(test-assert "manifest-matching-entries"
+  (let* ((e (list guile-2.0.9 guile-2.0.9:debug))
+         (m (manifest e)))
+    (and (null? (manifest-matching-entries m
+                                           (list (manifest-pattern
+                                                   (name "python")))))
+         (equal? e
+                 (manifest-matching-entries m
+                                            (list (manifest-pattern
+                                                    (name "guile")
+                                                    (output #f)))))
+         (equal? (list guile-2.0.9)
+                 (manifest-matching-entries m
+                                            (list (manifest-pattern
+                                                    (name "guile")
+                                                    (version "2.0.9"))))))))
+
+(test-assert "manifest-remove"
+  (let* ((m0 (manifest (list guile-2.0.9 guile-2.0.9:debug)))
+         (m1 (manifest-remove m0
+                              (list (manifest-pattern (name "guile")))))
+         (m2 (manifest-remove m1
+                              (list (manifest-pattern (name "guile"))))) ; same
+         (m3 (manifest-remove m2
+                              (list (manifest-pattern
+                                      (name "guile") (output "debug")))))
+         (m4 (manifest-remove m3
+                              (list (manifest-pattern (name "guile"))))))
+    (match (manifest-entries m2)
+      ((($ <manifest-entry> "guile" "2.0.9" "debug"))
+       (and (equal? m1 m2)
+            (null? (manifest-entries m3))
+            (null? (manifest-entries m4)))))))
+
+(test-end "profiles")
+
+
+(exit (= (test-runner-fail-count (test-runner-current)) 0))
+
+;;; Local Variables:
+;;; eval: (put 'dummy-package 'scheme-indent-function 1)
+;;; End:
diff --git a/tests/ui.scm b/tests/ui.scm
index 3d5c3e7969..08ee3967a8 100644
--- a/tests/ui.scm
+++ b/tests/ui.scm
@@ -65,6 +65,23 @@ interface, and powerful string processing.")
                    10)
    #\newline))
 
+(test-equal "package-specification->name+version+output"
+  '(("guile" #f "out")
+    ("guile" "2.0.9" "out")
+    ("guile" #f "debug")
+    ("guile" "2.0.9" "debug")
+    ("guile-cairo" "1.4.1" "out"))
+  (map (lambda (spec)
+         (call-with-values
+             (lambda ()
+               (package-specification->name+version+output spec))
+           list))
+       '("guile"
+         "guile-2.0.9"
+         "guile:debug"
+         "guile-2.0.9:debug"
+         "guile-cairo-1.4.1")))
+
 (test-equal "integer"
   '(1)
   (string->generations "1"))