Merge branch 'master' into core-updates

Conflicts:
	gnu-system.am

5 files changed, 166 insertions, 5 deletions

diff --git a/tests/derivations.scm b/tests/derivations.scm
index f7cedde505..f31b00b8a2 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -23,7 +23,8 @@
   #:use-module (guix utils)
   #:use-module (guix hash)
   #:use-module (guix base32)
-  #:use-module ((guix packages) #:select (package-derivation))
+  #:use-module ((guix packages) #:select (package-derivation base32))
+  #:use-module ((guix build utils) #:select (executable-file?))
   #:use-module ((gnu packages) #:select (search-bootstrap-binary))
   #:use-module (gnu packages bootstrap)
   #:use-module ((gnu packages guile) #:select (guile-1.8))
@@ -190,6 +191,23 @@
          (equal? (derivation->output-path drv1)
                  (derivation->output-path drv2)))))
 
+(test-assert "fixed-output derivation, recursive"
+  (let* ((builder    (add-text-to-store %store "my-fixed-builder.sh"
+                                        "echo -n hello > $out" '()))
+         (hash       (sha256 (string->utf8 "hello")))
+         (drv        (derivation %store "fixed-rec"
+                                 %bash `(,builder)
+                                 #:inputs `((,builder))
+                                 #:hash (base32 "0sg9f58l1jj88w6pdrfdpj5x9b1zrwszk84j81zvby36q9whhhqa")
+                                 #:hash-algo 'sha256
+                                 #:recursive? #t))
+         (succeeded? (build-derivations %store (list drv))))
+    (and succeeded?
+         (let ((p (derivation->output-path drv)))
+           (and (equal? (string->utf8 "hello")
+                        (call-with-input-file p get-bytevector-all))
+                (bytevector? (query-path-hash %store p)))))))
+
 (test-assert "derivation with a fixed-output input"
   ;; A derivation D using a fixed-output derivation F doesn't has the same
   ;; output path when passed F or F', as long as F and F' have the same output
@@ -637,6 +655,54 @@ Deriver: ~a~%"
                     (derivation-file-name final1)))
          (build-derivations %store (list final1 final2)))))
 
+(test-assert "build-expression->derivation produces recursive fixed-output"
+  (let* ((builder '(begin
+                     (use-modules (srfi srfi-26))
+                     (mkdir %output)
+                     (chdir %output)
+                     (call-with-output-file "exe"
+                       (cut display "executable" <>))
+                     (chmod "exe" #o777)
+                     (symlink "exe" "symlink")
+                     (mkdir "subdir")))
+         (drv     (build-expression->derivation %store "fixed-rec" builder
+                                                #:hash-algo 'sha256
+                                                #:hash (base32
+                                                        "10k1lw41wyrjf9mxydi0is5nkpynlsvgslinics4ppir13g7d74p")
+                                                #:recursive? #t)))
+    (and (build-derivations %store (list drv))
+         (let* ((dir    (derivation->output-path drv))
+                (exe    (string-append dir "/exe"))
+                (link   (string-append dir "/symlink"))
+                (subdir (string-append dir "/subdir")))
+           (and (executable-file? exe)
+                (string=? "executable"
+                          (call-with-input-file exe get-string-all))
+                (string=? "exe" (readlink link))
+                (file-is-directory? subdir))))))
+
+(test-assert "build-expression->derivation uses recursive fixed-output"
+  (let* ((builder '(call-with-output-file %output
+                     (lambda (port)
+                       (display "hello" port))))
+         (fixed   (build-expression->derivation %store "small-fixed-rec"
+                                                builder
+                                                #:hash-algo 'sha256
+                                                #:hash (base32
+                                                        "0sg9f58l1jj88w6pdrfdpj5x9b1zrwszk84j81zvby36q9whhhqa")
+                                                #:recursive? #t))
+         (in      (derivation->output-path fixed))
+         (builder `(begin
+                     (mkdir %output)
+                     (chdir %output)
+                     (symlink ,in "symlink")))
+         (drv     (build-expression->derivation %store "fixed-rec-user"
+                                                builder
+                                                #:inputs `(("fixed" ,fixed)))))
+    (and (build-derivations %store (list drv))
+         (let ((out (derivation->output-path drv)))
+           (string=? (readlink (string-append out "/symlink")) in)))))
+
 (test-assert "build-expression->derivation with #:references-graphs"
   (let* ((input   (add-text-to-store %store "foo" "hello"
                                      (list %bash %mkdir)))
diff --git a/tests/guix-hash.sh b/tests/guix-hash.sh
index 53325ce1f4..23df01d417 100644
--- a/tests/guix-hash.sh
+++ b/tests/guix-hash.sh
@@ -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.
 #
@@ -22,7 +22,27 @@
 
 guix hash --version
 
+tmpdir="guix-hash-$$"
+trap 'rm -rf "$tmpdir"' EXIT
+
 test `guix hash /dev/null` = 0mdqa9w1p6cmli6976v4wi0sw9r4p5prkj7lzfd1877wk11c9c73
 test `guix hash -f nix-base32 /dev/null` = 0mdqa9w1p6cmli6976v4wi0sw9r4p5prkj7lzfd1877wk11c9c73
 test `guix hash -f hex /dev/null` = e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855
 test `guix hash -f base32 /dev/null` = 4oymiquy7qobjgx36tejs35zeqt24qpemsnzgtfeswmrw6csxbkq
+
+mkdir "$tmpdir"
+echo -n executable > "$tmpdir/exe"
+chmod +x "$tmpdir/exe"
+( cd "$tmpdir" ; ln -s exe symlink )
+mkdir "$tmpdir/subdir"
+
+test `guix hash -r "$tmpdir"` = 10k1lw41wyrjf9mxydi0is5nkpynlsvgslinics4ppir13g7d74p
+
+# Without '-r', this should fail.
+if guix hash "$tmpdir"
+then false; else true; fi
+
+# This should fail because /dev/null is a character device, which
+# the archive format doesn't support.
+if guix hash -r /dev/null
+then false; else true; fi
diff --git a/tests/monads.scm b/tests/monads.scm
index d3f78e1568..b51e705f01 100644
--- a/tests/monads.scm
+++ b/tests/monads.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.
 ;;;
@@ -126,6 +126,30 @@
                            (readlink (string-append out "/guile-rocks"))))))
     #:guile-for-build (package-derivation %store %bootstrap-guile)))
 
+(test-assert "text-file*"
+  (let ((references (store-lift references)))
+    (run-with-store %store
+      (mlet* %store-monad
+          ((drv  (package->derivation %bootstrap-guile))
+           (guile -> (derivation->output-path drv))
+           (file (text-file "bar" "This is bar."))
+           (text (text-file* "foo"
+                             %bootstrap-guile "/bin/guile "
+                             `(,%bootstrap-guile "out") "/bin/guile "
+                             drv "/bin/guile "
+                             file))
+           (done (built-derivations (list text)))
+           (out -> (derivation->output-path text))
+           (refs (references out)))
+        ;; Make sure we get the right references and the right content.
+        (return (and (lset= string=? refs (list guile file))
+                     (equal? (call-with-input-file out get-string-all)
+                             (string-append guile "/bin/guile "
+                                            guile "/bin/guile "
+                                            guile "/bin/guile "
+                                            file)))))
+      #:guile-for-build (package-derivation %store %bootstrap-guile))))
+
 (test-assert "mapm"
   (every (lambda (monad run)
            (with-monad monad
diff --git a/tests/nar.scm b/tests/nar.scm
index 9f21f990c8..16a7845342 100644
--- a/tests/nar.scm
+++ b/tests/nar.scm
@@ -19,10 +19,14 @@
 (define-module (test-nar)
   #:use-module (guix nar)
   #:use-module (guix store)
-  #:use-module ((guix hash) #:select (open-sha256-input-port))
+  #:use-module ((guix hash)
+                #:select (open-sha256-port open-sha256-input-port))
+  #:use-module ((guix packages)
+                #:select (base32))
   #:use-module (rnrs bytevectors)
   #:use-module (rnrs io ports)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
@@ -183,6 +187,34 @@
 
 (test-begin "nar")
 
+(test-assert "write-file supports non-file output ports"
+  (let ((input  (string-append (dirname (search-path %load-path "guix.scm"))
+                               "/guix"))
+        (output (%make-void-port "w")))
+    (write-file input output)
+    #t))
+
+(test-equal "write-file puts file in C locale collation order"
+  (base32 "0sfn5r63k88w9ls4hivnvscg82bqg8a0w7955l6xlk4g96jnb2z3")
+  (let ((input (string-append %test-dir ".input")))
+    (dynamic-wind
+      (lambda ()
+        (define (touch file)
+          (call-with-output-file (string-append input "/" file)
+            (const #t)))
+
+        (mkdir input)
+        (touch "B")
+        (touch "Z")
+        (touch "a")
+        (symlink "B" (string-append input "/z")))
+      (lambda ()
+        (let-values (((port get-hash) (open-sha256-port)))
+          (write-file input port)
+          (get-hash)))
+      (lambda ()
+        (rm-rf input)))))
+
 (test-assert "write-file + restore-file"
   (let* ((input  (string-append (dirname (search-path %load-path "guix.scm"))
                                 "/guix"))
diff --git a/tests/store.scm b/tests/store.scm
index a61d449fb4..7b0f3249d2 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -398,6 +398,25 @@ Deriver: ~a~%"
                                  get-string-all))
                              files)))))))
 
+(test-assert "export/import paths, ensure topological order"
+  (let* ((file1 (add-text-to-store %store "foo" (random-text)))
+         (file2 (add-text-to-store %store "bar" (random-text)
+                                   (list file1)))
+         (files (list file1 file2))
+         (dump1 (call-with-bytevector-output-port
+                 (cute export-paths %store (list file1 file2) <>)))
+         (dump2 (call-with-bytevector-output-port
+                 (cute export-paths %store (list file2 file1) <>))))
+    (delete-paths %store files)
+    (and (every (negate file-exists?) files)
+         (bytevector=? dump1 dump2)
+         (let* ((source   (open-bytevector-input-port dump1))
+                (imported (import-paths %store source)))
+           (and (equal? imported (list file1 file2))
+                (every file-exists? files)
+                (null? (references %store file1))
+                (equal? (list file1) (references %store file2)))))))
+
 (test-assert "import corrupt path"
   (let* ((text (random-text))
          (file (add-text-to-store %store "text" text))