diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/derivations.scm | 25 | ||||
| -rw-r--r-- | tests/packages.scm | 60 | ||||
| -rw-r--r-- | tests/profiles.scm | 97 | ||||
| -rw-r--r-- | tests/ui.scm | 17 |
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")) |