summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-11-08 21:58:09 +0100
committerLudovic Courtès <ludo@gnu.org>2013-11-08 21:58:09 +0100
commit7db9608d52ab431165ab150a0a0707c686990c1c (patch)
treeb19d49a71e71f8da939a4825b545da3a31907e65 /tests
parent7a78cc7af24a1303dd0117cb977e15ca89a5dad8 (diff)
parent6a9957545ce51e7a50381059d4509d0dfcba0aba (diff)
Merge branch 'master' into core-updates
Conflicts: guix/packages.scm
Diffstat (limited to 'tests')
-rw-r--r--tests/derivations.scm25
-rw-r--r--tests/packages.scm60
-rw-r--r--tests/profiles.scm97
-rw-r--r--tests/ui.scm17
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"))