diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2020-04-04 17:36:31 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2020-04-04 18:52:35 +0200 |
| commit | 8ed597f4a261fe188de82cd1f5daed83dba948eb (patch) | |
| tree | 11a5d45ad494bf6d0244fd3248664c536e9fa333 /tests | |
| parent | d8c8bfcc1f7c2e8226abebc6227261c8617f90d0 (diff) | |
| download | guix-8ed597f4a261fe188de82cd1f5daed83dba948eb.tar.gz guix-8ed597f4a261fe188de82cd1f5daed83dba948eb.zip | |
store: 'with-store' doesn't close the store upon abort.
Fixes <https://bugs.gnu.org/40428>.
Reported by Marius Bakke <mbakke@fastmail.com> and 白い熊.
Regression introduced with the first uses of 'with-build-handler' in
commit 62195b9a8fd6846117c5d7698842748300d13e31 and subsequent.
* guix/store.scm (call-with-store): Use 'catch #t' instead of
'dynamic-wind'. This ensures STORE remains open when a non-local exit
other than an exception occurs, such as an abort to the build handler
prompt.
* tests/store.scm ("with-build-handler + with-store"): New test.
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/store.scm | 27 |
1 files changed, 27 insertions, 0 deletions
diff --git a/tests/store.scm b/tests/store.scm index 0458a34746..0e80ccc239 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -412,6 +412,33 @@ (build-derivations %store (list d2)) 'fail))) +(test-equal "with-build-handler + with-store" + 'success + ;; Check that STORE remains valid when the build handler invokes CONTINUE, + ;; even though 'with-build-handler' is outside the dynamic extent of + ;; 'with-store'. + (with-build-handler (lambda (continue store things mode) + (match things + ((drv) + (and (string-suffix? "thingie.drv" drv) + (not (port-closed? + (store-connection-socket store))) + (continue #t))))) + (with-store store + (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 "thingie" + s `("-e" ,b) + #:env-vars `(("foo" . ,(random-text))) + #:sources (list b s)))) + (build-derivations store (list d)) + + ;; Here STORE's socket should still be open. + (and (valid-path? store (derivation->output-path d)) + 'success))))) + (test-assert "map/accumulate-builds" (let* ((b (add-text-to-store %store "build" "echo $foo > $out" '())) (s (add-to-store %store "bash" #t "sha256" |