diff options
Diffstat (limited to 'tests')
-rw-r--r-- | tests/derivations.scm | 15 | ||||
-rw-r--r-- | tests/guix-build.sh | 4 | ||||
-rw-r--r-- | tests/guix-daemon.sh | 2 | ||||
-rw-r--r-- | tests/guix-package.sh | 7 | ||||
-rw-r--r-- | tests/opam.scm | 4 | ||||
-rw-r--r-- | tests/profiles.scm | 17 | ||||
-rw-r--r-- | tests/status.scm | 33 | ||||
-rw-r--r-- | tests/store.scm | 13 |
8 files changed, 77 insertions, 18 deletions
diff --git a/tests/derivations.scm b/tests/derivations.scm index c0601c0e88..dbb5b584eb 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -650,18 +650,19 @@ (build-derivations %store (list drv)) #f))) -;; Here we should get the value of $NIX_STATE_DIR that the daemon sees, which -;; is a unique value for each test process; this value is the same as the one -;; we see in the process executing this file since it is set by 'test-env'. +;; Here we should get the value of $GUIX_STATE_DIRECTORY that the daemon sees, +;; which is a unique value for each test process; this value is the same as +;; the one we see in the process executing this file since it is set by +;; 'test-env'. (test-equal "derivation #:leaked-env-vars" - (getenv "NIX_STATE_DIR") - (let* ((value (getenv "NIX_STATE_DIR")) + (getenv "GUIX_STATE_DIRECTORY") + (let* ((value (getenv "GUIX_STATE_DIRECTORY")) (drv (derivation %store "leaked-env-vars" %bash - '("-c" "echo -n $NIX_STATE_DIR > $out") + '("-c" "echo -n $GUIX_STATE_DIRECTORY > $out") #:hash (sha256 (string->utf8 value)) #:hash-algo 'sha256 #:inputs `((,%bash)) - #:leaked-env-vars '("NIX_STATE_DIR")))) + #:leaked-env-vars '("GUIX_STATE_DIRECTORY")))) (and (build-derivations %store (list drv)) (call-with-input-file (derivation->output-path drv) get-string-all)))) diff --git a/tests/guix-build.sh b/tests/guix-build.sh index 7842ce87c6..66bf6be8d0 100644 --- a/tests/guix-build.sh +++ b/tests/guix-build.sh @@ -1,5 +1,5 @@ # GNU Guix --- Functional package management for GNU -# Copyright © 2012, 2013, 2014, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> +# Copyright © 2012, 2013, 2014, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> # # This file is part of GNU Guix. # @@ -37,7 +37,7 @@ guix build hello -d | \ grep -e '-hello-[0-9\.]\+\.drv$' # Passing a URI. -GUIX_DAEMON_SOCKET="file://$NIX_STATE_DIR/daemon-socket/socket" \ +GUIX_DAEMON_SOCKET="file://$GUIX_STATE_DIRECTORY/daemon-socket/socket" \ guix build -e '(@@ (gnu packages bootstrap) %bootstrap-guile)' ( if GUIX_DAEMON_SOCKET="weird://uri" \ diff --git a/tests/guix-daemon.sh b/tests/guix-daemon.sh index 4c19a55722..ce82cfd1e6 100644 --- a/tests/guix-daemon.sh +++ b/tests/guix-daemon.sh @@ -63,7 +63,7 @@ guile -c " (exit (has-substitutes? store \"$out\"))" # Now, run guix-daemon --no-substitutes. -socket="$NIX_STATE_DIR/alternate-socket" +socket="$GUIX_STATE_DIRECTORY/alternate-socket" guix-daemon --no-substitutes --listen="$socket" --disable-chroot & daemon_pid=$! trap 'kill $daemon_pid' EXIT diff --git a/tests/guix-package.sh b/tests/guix-package.sh index 7eeb4304d1..0d60481895 100644 --- a/tests/guix-package.sh +++ b/tests/guix-package.sh @@ -1,5 +1,5 @@ # GNU Guix --- Functional package management for GNU -# Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> +# Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> # Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> # # This file is part of GNU Guix. @@ -97,6 +97,11 @@ then false; else true; fi if guix package --bootstrap -i "guile-bootstrap:does-not-exist" -p "$profile"; then false; else true; fi +# Make sure we get an error when trying to remove something that's not +# installed. +if guix package --bootstrap -r something-not-installed -p "$profile"; +then false; else true; fi + # Check whether `--list-available' returns something sensible. guix package -p "$profile" -A 'gui.*e' | grep guile diff --git a/tests/opam.scm b/tests/opam.scm index e0ec5ef3d4..e8c0d15198 100644 --- a/tests/opam.scm +++ b/tests/opam.scm @@ -192,6 +192,8 @@ url { ("{>= \"0.2.0\" | build}" . (condition-or (condition-greater-or-equal (condition-string "0.2.0")) - (condition-var "build")))))) + (condition-var "build"))) + ("{ = \"1.0+beta19\" }" . (condition-eq + (condition-string "1.0+beta19")))))) (test-end "opam") diff --git a/tests/profiles.scm b/tests/profiles.scm index 9a05030aff..eef93e24cf 100644 --- a/tests/profiles.scm +++ b/tests/profiles.scm @@ -93,10 +93,7 @@ (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 + (and (equal? e (manifest-matching-entries m (list (manifest-pattern (name "guile") @@ -107,6 +104,15 @@ (name "guile") (version "2.0.9")))))))) +(test-assert "manifest-matching-entries, no match" + (let ((m (manifest (list guile-2.0.9))) + (p (manifest-pattern (name "python")))) + (guard (c ((unmatched-pattern-error? c) + (and (eq? p (unmatched-pattern-error-pattern c)) + (eq? m (unmatched-pattern-error-manifest c))))) + (manifest-matching-entries m (list p)) + #f))) + (test-assert "manifest-remove" (let* ((m0 (manifest (list guile-2.0.9 guile-2.0.9:debug))) (m1 (manifest-remove m0 @@ -165,8 +171,7 @@ (test-assert "manifest-transaction-effects" (let* ((m0 (manifest (list guile-1.8.8))) (t (manifest-transaction - (install (list guile-2.0.9 glibc)) - (remove (list (manifest-pattern (name "coreutils"))))))) + (install (list guile-2.0.9 glibc))))) (let-values (((remove install upgrade downgrade) (manifest-transaction-effects m0 t))) (and (null? remove) (null? downgrade) diff --git a/tests/status.scm b/tests/status.scm index f3afadfcd0..01a61f7345 100644 --- a/tests/status.scm +++ b/tests/status.scm @@ -211,4 +211,37 @@ (display "@ build-succeeded foo.drv\n" port) (list first second third (get-status))))))) +(test-equal "compute-status, build phase" + (list (build-status + (building (list (build "foo.drv" "x86_64-linux" #:id 121 + #:phase 'configure)))) + (build-status + (building (list (build "foo.drv" "x86_64-linux" #:id 121 + #:phase 'configure + #:completion 50.)))) + (build-status + (building (list (build "foo.drv" "x86_64-linux" #:id 121 + #:phase 'install)))) + (build-status + (builds-completed (list (build "foo.drv" "x86_64-linux" #:id 121 + #:phase 'install))))) + (let-values (((port get-status) + (build-event-output-port (lambda (event status) + (compute-status event status + #:current-time + (const 'now)))))) + (display "@ build-started foo.drv - x86_64-linux 121\n" port) + (display "@ build-log 121 27\nstarting phase `configure'\n" port) + (display "@ build-log 121 6\nabcde!" port) + (let ((first (get-status))) + (display "@ build-log 121 20\n[50/100] building Y\n" port) + (display "@ build-log 121 6\nfghik!" port) + (let ((second (get-status))) + (display "@ build-log 121 21\n[100/100] building Z\n" port) + (display "@ build-log 121 25\nstarting phase `install'\n" port) + (display "@ build-log 121 6\nlmnop!" port) + (let ((third (get-status))) + (display "@ build-succeeded foo.drv\n" port) + (list first second third (get-status))))))) + (test-end "status") diff --git a/tests/store.scm b/tests/store.scm index e28c0c5aaa..df66feaebb 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -917,6 +917,19 @@ (build-mode check)) #f)))))))) +(test-assert "build-succeeded trace in check mode" + (string-contains + (call-with-output-string + (lambda (port) + (let ((d (build-expression->derivation + %store "foo" '(mkdir (assoc-ref %outputs "out")) + #:guile-for-build + (package-derivation %store %bootstrap-guile)))) + (build-derivations %store (list d)) + (parameterize ((current-build-output-port port)) + (build-derivations %store (list d) (build-mode check)))))) + "@ build-succeeded")) + (test-assert "build multiple times" (with-store store ;; Ask to build twice. |