diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2020-03-18 22:17:39 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2020-03-22 12:42:51 +0100 |
| commit | 041b340da409078951267b6a8c43b27716e6b7ec (patch) | |
| tree | 8542b6fc4e47d6f7245c1549c45348db69f2cc5f /tests | |
| parent | 9a067fe7ee3978a2f4f0ca0e89965f0fe49f4ce8 (diff) | |
| download | patches-041b340da409078951267b6a8c43b27716e6b7ec.tar patches-041b340da409078951267b6a8c43b27716e6b7ec.tar.gz | |
store: Add 'with-build-handler'.
* guix/store.scm (current-build-prompt): New variable.
(call-with-build-handler, invoke-build-handler): New procedures.
(with-build-handler): New macro.
* tests/store.scm ("with-build-handler"): New test.
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/store.scm | 34 |
1 files changed, 33 insertions, 1 deletions
diff --git a/tests/store.scm b/tests/store.scm index 2b14a4af0a..b61a981b28 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -380,6 +380,38 @@ (equal? (valid-derivers %store o) (list (derivation-file-name d)))))) +(test-equal "with-build-handler" + 'success + (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)))) + (d1 (derivation %store "the-thing" + s `("-e" ,b) + #:env-vars `(("foo" . ,(random-text))) + #:sources (list b s))) + (d2 (derivation %store "the-thing" + s `("-e" ,b) + #:env-vars `(("foo" . ,(random-text)) + ("bar" . "baz")) + #:sources (list b s))) + (o1 (derivation->output-path d1)) + (o2 (derivation->output-path d2))) + (with-build-handler + (let ((counter 0)) + (lambda (continue store things mode) + (match things + ((drv) + (set! counter (+ 1 counter)) + (if (string=? drv (derivation-file-name d1)) + (continue #t) + (and (string=? drv (derivation-file-name d2)) + (= counter 2) + 'success)))))) + (build-derivations %store (list d1)) + (build-derivations %store (list d2)) + 'fail))) + (test-assert "topologically-sorted, one item" (let* ((a (add-text-to-store %store "a" "a")) (b (add-text-to-store %store "b" "b" (list a))) |