summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/cran.scm12
-rw-r--r--tests/derivations.scm27
-rw-r--r--tests/gem.scm2
-rw-r--r--tests/import-utils.scm39
-rw-r--r--tests/lint.scm5
-rw-r--r--tests/publish.scm4
-rw-r--r--tests/system.scm77
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))
generated by cgit v1.2.3 (git 2.46.2) at 2024-12-27 06:48:40 +0000