summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-11-20 23:51:26 +0100
committerLudovic Courtès <ludo@gnu.org>2013-11-20 23:51:26 +0100
commitedae5b3d50692c25e29fe65fdc14ae3ccdce884d (patch)
treeec257af3a922fd96bda8b8b16c00c8d0beaf445a /tests
parent1dba64079c5aaa1fb40e4b1d989f1f06efd6cb63 (diff)
parente3aaefe71bd26daf6fdbfd0634f68a90985e059b (diff)
downloadpatches-edae5b3d50692c25e29fe65fdc14ae3ccdce884d.tar
patches-edae5b3d50692c25e29fe65fdc14ae3ccdce884d.tar.gz
Merge branch 'master' into core-updates
Conflicts: guix/packages.scm
Diffstat (limited to 'tests')
-rw-r--r--tests/derivations.scm52
-rw-r--r--tests/guix-build.sh19
-rw-r--r--tests/packages.scm17
-rw-r--r--tests/store.scm36
-rw-r--r--tests/utils.scm8
5 files changed, 132 insertions, 0 deletions
diff --git a/tests/derivations.scm b/tests/derivations.scm
index 273db22765..a4e073bf07 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -26,6 +26,7 @@
#:use-module ((guix packages) #:select (package-derivation))
#:use-module ((gnu packages) #:select (search-bootstrap-binary))
#:use-module (gnu packages bootstrap)
+ #:use-module ((gnu packages guile) #:select (guile-1.8))
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
@@ -690,6 +691,57 @@ Deriver: ~a~%"
((p2 . _)
(string<? p1 p2)))))))))))))
+
+(test-equal "map-derivation"
+ "hello"
+ (let* ((joke (package-derivation %store guile-1.8))
+ (good (package-derivation %store %bootstrap-guile))
+ (drv1 (build-expression->derivation %store "original-drv1"
+ (%current-system)
+ #f ; systematically fail
+ '()
+ #:guile-for-build joke))
+ (drv2 (build-expression->derivation %store "original-drv2"
+ (%current-system)
+ '(call-with-output-file %output
+ (lambda (p)
+ (display "hello" p)))
+ '()))
+ (drv3 (build-expression->derivation %store "drv-to-remap"
+ (%current-system)
+ '(let ((in (assoc-ref
+ %build-inputs "in")))
+ (copy-file in %output))
+ `(("in" ,drv1))
+ #:guile-for-build joke))
+ (drv4 (map-derivation %store drv3 `((,drv1 . ,drv2)
+ (,joke . ,good))))
+ (out (derivation->output-path drv4)))
+ (and (build-derivations %store (list (pk 'remapped drv4)))
+ (call-with-input-file out get-string-all))))
+
+(test-equal "map-derivation, sources"
+ "hello"
+ (let* ((script1 (add-text-to-store %store "fail.sh" "exit 1"))
+ (script2 (add-text-to-store %store "hi.sh" "echo -n hello > $out"))
+ (bash-full (package-derivation %store (@ (gnu packages bash) bash)))
+ (drv1 (derivation %store "drv-to-remap"
+
+ ;; XXX: This wouldn't work in practice, but if
+ ;; we append "/bin/bash" then we can't replace
+ ;; it with the bootstrap bash, which is a
+ ;; single file.
+ (derivation->output-path bash-full)
+
+ `("-e" ,script1)
+ #:inputs `((,bash-full) (,script1))))
+ (drv2 (map-derivation %store drv1
+ `((,bash-full . ,%bash)
+ (,script1 . ,script2))))
+ (out (derivation->output-path drv2)))
+ (and (build-derivations %store (list (pk 'remapped* drv2)))
+ (call-with-input-file out get-string-all))))
+
(test-end)
diff --git a/tests/guix-build.sh b/tests/guix-build.sh
index 83de9f5285..391e7b9da3 100644
--- a/tests/guix-build.sh
+++ b/tests/guix-build.sh
@@ -36,6 +36,17 @@ guix build -e '(@@ (gnu packages base) %bootstrap-guile)' | \
guix build hello -d | \
grep -e '-hello-[0-9\.]\+\.drv$'
+# Should all return valid log files.
+drv="`guix build -d -e '(@@ (gnu packages base) %bootstrap-guile)'`"
+out="`guix build -e '(@@ (gnu packages base) %bootstrap-guile)'`"
+log="`guix build --log-file $drv`"
+echo "$log" | grep log/.*guile.*drv
+test -f "$log"
+test "`guix build -e '(@@ (gnu packages base) %bootstrap-guile)' --log-file`" \
+ = "$log"
+test "`guix build --log-file guile-bootstrap`" = "$log"
+test "`guix build --log-file $out`" = "$log"
+
# Should fail because the name/version combination could not be found.
if guix build hello-0.0.1 -n; then false; else true; fi
@@ -61,3 +72,11 @@ if guix build -n time-3.2; # FAIL, version not found
then false; else true; fi
if guix build -n something-that-will-never-exist; # FAIL
then false; else true; fi
+
+# Invoking a monadic procedure.
+guix build -e "(begin
+ (use-modules (guix monads) (guix utils))
+ (lambda ()
+ (derivation-expression \"test\" (%current-system)
+ '(mkdir %output) '())))" \
+ --dry-run
diff --git a/tests/packages.scm b/tests/packages.scm
index 8d0d205f54..04e3b0bce9 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -81,6 +81,12 @@
(list version `(version ,version))))
(not (package-field-location %bootstrap-guile 'does-not-exist)))))
+;; Make sure we don't change the file name to an absolute file name.
+(test-equal "package-field-location, relative file name"
+ (location-file (package-location %bootstrap-guile))
+ (with-fluids ((%file-port-name-canonicalization 'absolute))
+ (location-file (package-field-location %bootstrap-guile 'version))))
+
(test-assert "package-transitive-inputs"
(let* ((a (dummy-package "a"))
(b (dummy-package "b"
@@ -122,6 +128,17 @@
(package-source package))))
(string=? file source)))
+(test-assert "package-source-derivation, indirect store path"
+ (let* ((dir (add-to-store %store "guix-build" #t "sha256"
+ (dirname (search-path %load-path
+ "guix/build/utils.scm"))))
+ (package (package (inherit (dummy-package "p"))
+ (source (string-append dir "/utils.scm"))))
+ (source (package-source-derivation %store
+ (package-source package))))
+ (and (direct-store-path? source)
+ (string-suffix? "utils.scm" source))))
+
(test-equal "package-source-derivation, snippet"
"OK"
(let* ((file (search-bootstrap-binary "guile-2.0.9.tar.xz"
diff --git a/tests/store.scm b/tests/store.scm
index b5e0cb0eab..741803884d 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -65,6 +65,15 @@
(string-append (%store-prefix)
"/foo/bar/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7")))
+(test-assert "direct-store-path?"
+ (and (direct-store-path?
+ (string-append (%store-prefix)
+ "/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7"))
+ (not (direct-store-path?
+ (string-append
+ (%store-prefix)
+ "/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7/bin/guile")))))
+
(test-skip (if %store 0 10))
(test-assert "dead-paths"
@@ -140,6 +149,33 @@
(equal? (valid-derivers %store o)
(list (derivation-file-name d))))))
+(test-assert "log-file, derivation"
+ (let* ((b (add-text-to-store %store "build" "echo $foo > $out" '()))
+ (s (add-to-store %store "bash" #t "sha256"
+ (search-bootstrap-binary "bash"
+ (%current-system))))
+ (d (derivation %store "the-thing"
+ s `("-e" ,b)
+ #:env-vars `(("foo" . ,(random-text)))
+ #:inputs `((,b) (,s)))))
+ (and (build-derivations %store (list d))
+ (file-exists? (pk (log-file %store (derivation-file-name d)))))))
+
+(test-assert "log-file, output file name"
+ (let* ((b (add-text-to-store %store "build" "echo $foo > $out" '()))
+ (s (add-to-store %store "bash" #t "sha256"
+ (search-bootstrap-binary "bash"
+ (%current-system))))
+ (d (derivation %store "the-thing"
+ s `("-e" ,b)
+ #:env-vars `(("foo" . ,(random-text)))
+ #:inputs `((,b) (,s))))
+ (o (derivation->output-path d)))
+ (and (build-derivations %store (list d))
+ (file-exists? (pk (log-file %store o)))
+ (string=? (log-file %store (derivation-file-name d))
+ (log-file %store o)))))
+
(test-assert "no substitutes"
(let* ((s (open-connection))
(d1 (package-derivation s %bootstrap-guile (%current-system)))
diff --git a/tests/utils.scm b/tests/utils.scm
index 4f6ecc514d..017d9170fa 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -82,6 +82,14 @@
(string-tokenize* "foo!bar!" "!")
(string-tokenize* "foo+-+bar+-+baz" "+-+")))
+(test-equal "string-replace-substring"
+ '("foo BAR! baz"
+ "/gnu/store/chbouib"
+ "")
+ (list (string-replace-substring "foo bar baz" "bar" "BAR!")
+ (string-replace-substring "/nix/store/chbouib" "/nix/" "/gnu/")
+ (string-replace-substring "" "foo" "bar")))
+
(test-equal "fold2, 1 list"
(list (reverse (iota 5))
(map - (reverse (iota 5))))