diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/derivations.scm | 52 | ||||
| -rw-r--r-- | tests/guix-build.sh | 19 | ||||
| -rw-r--r-- | tests/packages.scm | 17 | ||||
| -rw-r--r-- | tests/store.scm | 36 | ||||
| -rw-r--r-- | tests/utils.scm | 8 |
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)))) |