diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/cran.scm | 12 | ||||
| -rw-r--r-- | tests/derivations.scm | 27 | ||||
| -rw-r--r-- | tests/gem.scm | 2 | ||||
| -rw-r--r-- | tests/import-utils.scm | 39 | ||||
| -rw-r--r-- | tests/lint.scm | 5 | ||||
| -rw-r--r-- | tests/publish.scm | 4 | ||||
| -rw-r--r-- | tests/system.scm | 77 |
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)) |