diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/derivations.scm | 10 | ||||
| -rw-r--r-- | tests/gexp.scm | 10 | ||||
| -rw-r--r-- | tests/grafts.scm | 13 | ||||
| -rw-r--r-- | tests/inferior.scm | 9 |
4 files changed, 36 insertions, 6 deletions
diff --git a/tests/derivations.scm b/tests/derivations.scm index 159a6971b3..5f294c1827 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -1132,6 +1132,16 @@ ((p2 . _) (string<? p1 p2))))))))))))) +(test-equal "derivation-properties" + (list '() '((type . test))) + (let ((drv1 (build-expression->derivation %store "bar" + '(mkdir %output))) + (drv2 (build-expression->derivation %store "foo" + '(mkdir %output) + #:properties '((type . test))))) + (list (derivation-properties drv1) + (derivation-properties drv2)))) + (test-equal "map-derivation" "hello" (let* ((joke (package-derivation %store guile-1.8)) diff --git a/tests/gexp.scm b/tests/gexp.scm index ff68d26ba9..35a76a496e 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -476,7 +476,15 @@ (return (and (string=? (readlink (string-append out "/foo")) guile) (string=? (readlink out2) file) (equal? refs (list (dirname (dirname guile)))) - (equal? refs2 (list file)))))) + (equal? refs2 (list file)) + (null? (derivation-properties drv)))))) + +(test-assertm "gexp->derivation properties" + (mlet %store-monad ((drv (gexp->derivation "foo" + #~(mkdir #$output) + #:properties '((type . test))))) + (return (equal? '((type . test)) + (derivation-properties drv))))) (test-assertm "gexp->derivation vs. grafts" (mlet* %store-monad ((graft? (set-grafting #f)) diff --git a/tests/grafts.scm b/tests/grafts.scm index abb074d628..f85f3c6913 100644 --- a/tests/grafts.scm +++ b/tests/grafts.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -51,7 +51,8 @@ (test-begin "grafts") -(test-assert "graft-derivation, grafted item is a direct dependency" +(test-equal "graft-derivation, grafted item is a direct dependency" + '((type . graft) (graft (count . 2))) (let* ((build `(begin (mkdir %output) (chdir %output) @@ -76,14 +77,16 @@ (origin %mkdir) (replacement two)))))) (and (build-derivations %store (list grafted)) - (let ((two (derivation->output-path two)) - (grafted (derivation->output-path grafted))) + (let ((properties (derivation-properties grafted)) + (two (derivation->output-path two)) + (grafted (derivation->output-path grafted))) (and (string=? (format #f "foo/~a/bar" two) (call-with-input-file (string-append grafted "/text") get-string-all)) (string=? (readlink (string-append grafted "/sh")) one) (string=? (readlink (string-append grafted "/self")) - grafted)))))) + grafted) + properties))))) (test-assert "graft-derivation, grafted item uses a different name" (let* ((build `(begin diff --git a/tests/inferior.scm b/tests/inferior.scm index d1d5c00a77..d5a894ca8f 100644 --- a/tests/inferior.scm +++ b/tests/inferior.scm @@ -157,6 +157,15 @@ (close-inferior inferior) result)) +(test-equal "inferior-eval-with-store" + (add-text-to-store %store "foo" "Hello, world!") + (let* ((inferior (open-inferior %top-builddir + #:command "scripts/guix"))) + (inferior-eval-with-store inferior %store + '(lambda (store) + (add-text-to-store store "foo" + "Hello, world!"))))) + (test-equal "inferior-package-derivation" (map derivation-file-name (list (package-derivation %store %bootstrap-guile "x86_64-linux") |