Merge branch 'master' into core-updates

7 files changed, 153 insertions, 13 deletions

diff --git a/tests/cran.scm b/tests/cran.scm
index 0a4a2fdd8f..83d2e7f554 100644
--- a/tests/cran.scm
+++ b/tests/cran.scm
@@ -86,16 +86,6 @@ Date/Publication: 2015-07-14 14:15:16
   '()
   ((@@ (guix import cran) listify) simple-alist "BadList"))
 
-(test-equal "beautify-description: use double spacing"
-  "This is a package.  It is great.  Trust me Mr.  Hendrix."
-  ((@@ (guix import cran) beautify-description)
-   "This is a package. It is great. Trust me Mr. Hendrix."))
-
-(test-equal "beautify-description: transform fragment into sentence"
-  "This package provides a function to establish world peace"
-  ((@@ (guix import cran) beautify-description)
-   "A function to establish world peace"))
-
 (test-assert "description->package"
   ;; Replace network resources with sample data.
   (mock ((guix build download) url-fetch
@@ -107,7 +97,7 @@ Date/Publication: 2015-07-14 14:15:16
                   ("mirror://cran/src/contrib/My-Example_1.2.3.tar.gz"
                    "source")
                   (_ (error "Unexpected URL: " url))))))))
-    (match ((@@ (guix import cran) description->package) description-alist)
+    (match ((@@ (guix import cran) description->package) 'cran description-alist)
       (('package
          ('name "r-my-example")
          ('version "1.2.3")
diff --git a/tests/derivations.scm b/tests/derivations.scm
index 64cc8a94c9..db96e26ab1 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -151,6 +151,33 @@
          ;; the contents.
          (valid-path? %store (derivation->output-path drv)))))
 
+(test-assert "derivation fails but keep going"
+  ;; In keep-going mode, 'build-derivations' should fail because of D1, but it
+  ;; must return only after D2 has succeeded.
+  (with-store store
+    (let* ((d1 (derivation %store "fails"
+                           %bash `("-c" "false")
+                           #:inputs `((,%bash))))
+           (d2 (build-expression->derivation %store "sleep-then-succeed"
+                                             `(begin
+                                                ,(random-text)
+                                                ;; XXX: Hopefully that's long
+                                                ;; enough that D1 has already
+                                                ;; failed.
+                                                (sleep 2)
+                                                (mkdir %output)))))
+      (set-build-options %store
+                         #:use-substitutes? #f
+                         #:keep-going? #t)
+      (guard (c ((nix-protocol-error? c)
+                 (and (= 100 (nix-protocol-error-status c))
+                      (string-contains (nix-protocol-error-message c)
+                                       (derivation-file-name d1))
+                      (not (valid-path? %store (derivation->output-path d1)))
+                      (valid-path? %store (derivation->output-path d2)))))
+        (build-derivations %store (list d1 d2))
+        #f))))
+
 (test-assert "identical files are deduplicated"
   (let* ((build1  (add-text-to-store %store "one.sh"
                                      "echo hello, world > \"$out\"\n"
diff --git a/tests/gem.scm b/tests/gem.scm
index 9efbda31fe..ebce809840 100644
--- a/tests/gem.scm
+++ b/tests/gem.scm
@@ -69,7 +69,7 @@
            (("bundler" ('unquote 'bundler))
             ("ruby-bar" ('unquote 'ruby-bar)))))
          ('synopsis "A cool gem")
-         ('description "A cool gem")
+         ('description "This package provides a cool gem")
          ('home-page "https://example.com")
          ('license ('list 'expat 'asl2.0)))
        #t)
diff --git a/tests/import-utils.scm b/tests/import-utils.scm
new file mode 100644
index 0000000000..08365816d4
--- /dev/null
+++ b/tests/import-utils.scm
@@ -0,0 +1,39 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com>
+;;;
+;;; 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-import-utils)
+  #:use-module (guix tests)
+  #:use-module (guix import utils)
+  #:use-module (srfi srfi-64))
+
+(test-begin "import-utils")
+
+(test-equal "beautify-description: use double spacing"
+  "This is a package.  It is great.  Trust me Mr.  Hendrix."
+  (beautify-description
+   "This is a package. It is great. Trust me Mr. Hendrix."))
+
+(test-equal "beautify-description: transform fragment into sentence"
+  "This package provides a function to establish world peace"
+  (beautify-description "A function to establish world peace"))
+
+(test-end "import-utils")
+
+
+(exit (= (test-runner-fail-count (test-runner-current)) 0))
diff --git a/tests/lint.scm b/tests/lint.scm
index df82593a9e..b8dad13ceb 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -1,7 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2012, 2013 Cyril Roelandt <tipecaml@gmail.com>
 ;;; Copyright © 2014, 2015 Eric Bavier <bavier@member.fsf.org>
-;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Mathieu Lirzin <mthl@openmailbox.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -19,6 +19,9 @@
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
+;; Avoid interference.
+(unsetenv "http_proxy")
+
 (define-module (test-lint)
   #:use-module (guix tests)
   #:use-module (guix download)
diff --git a/tests/publish.scm b/tests/publish.scm
index 4d72fdc468..0b92390900 100644
--- a/tests/publish.scm
+++ b/tests/publish.scm
@@ -16,6 +16,9 @@
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
+;; Avoid interference.
+(unsetenv "http_proxy")
+
 (define-module (test-publish)
   #:use-module (guix scripts publish)
   #:use-module (guix tests)
@@ -62,6 +65,7 @@
              (connect conn AF_INET (inet-pton AF_INET "127.0.0.1") 6789))
       (loop))))
 
+
 (test-begin "publish")
 
 (test-equal "/nix-cache-info"
diff --git a/tests/system.scm b/tests/system.scm
new file mode 100644
index 0000000000..7e016a610b
--- /dev/null
+++ b/tests/system.scm
@@ -0,0 +1,77 @@
+;;; 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-system)
+  #:use-module (gnu)
+  #:use-module (guix store)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-64))
+
+;; Test the (gnu system) module.
+
+(define %root-fs
+  (file-system
+    (device "my-root")
+    (title 'label)
+    (mount-point "/")
+    (type "ext4")))
+
+(define %os
+  (operating-system
+    (host-name "komputilo")
+    (timezone "Europe/Berlin")
+    (locale "en_US.utf8")
+    (bootloader (grub-configuration (device "/dev/sdX")))
+    (file-systems (cons %root-fs %base-file-systems))
+
+    (users %base-user-accounts)))
+
+(test-begin "system")
+
+(test-assert "operating-system-store-file-system"
+  ;; %BASE-FILE-SYSTEMS defines a bind-mount for /gnu/store, but this
+  ;; shouldn't be a problem.
+  (eq? %root-fs
+       (operating-system-store-file-system %os)))
+
+(test-assert "operating-system-store-file-system, prefix"
+  (let* ((gnu (file-system
+                (device "foobar")
+                (mount-point (dirname (%store-prefix)))
+                (type "ext5")))
+         (os  (operating-system
+                (inherit %os)
+                (file-systems (cons* gnu %root-fs
+                                     %base-file-systems)))))
+    (eq? gnu (operating-system-store-file-system os))))
+
+(test-assert "operating-system-store-file-system, store"
+  (let* ((gnu (file-system
+                (device "foobar")
+                (mount-point (%store-prefix))
+                (type "ext5")))
+         (os  (operating-system
+                (inherit %os)
+                (file-systems (cons* gnu %root-fs
+                                     %base-file-systems)))))
+    (eq? gnu (operating-system-store-file-system os))))
+
+(test-end)
+
+
+(exit (= (test-runner-fail-count (test-runner-current)) 0))