diff options
| -rw-r--r-- | guix/store.scm | 15 | ||||
| -rw-r--r-- | tests/guix-daemon.sh | 39 |
2 files changed, 53 insertions, 1 deletions
diff --git a/guix/store.scm b/guix/store.scm index 5f37e72589..c4e3573711 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -67,6 +67,8 @@ add-to-store build-things build + query-failed-paths + clear-failed-paths add-temp-root add-indirect-root add-permanent-root @@ -889,6 +891,19 @@ PATHS---i.e., PATHS and all their dependencies." (and (export-path server head port #:sign? sign?) (loop tail)))))) +(define-operation (query-failed-paths) + "Return the list of store items for which a build failure is cached. + +The result is always the empty list unless the daemon was started with +'--cache-failures'." + store-path-list) + +(define-operation (clear-failed-paths (store-path-list items)) + "Remove ITEMS from the list of cached build failures. + +This makes sense only when the daemon was started with '--cache-failures'." + boolean) + (define* (register-path path #:key (references '()) deriver prefix state-directory) diff --git a/tests/guix-daemon.sh b/tests/guix-daemon.sh index 0de6f278e4..1f9c868293 100644 --- a/tests/guix-daemon.sh +++ b/tests/guix-daemon.sh @@ -65,7 +65,7 @@ guile -c " socket="$NIX_STATE_DIR/alternate-socket" guix-daemon --no-substitutes --listen="$socket" --disable-chroot & daemon_pid=$! -trap "kill $daemon_pid" EXIT +trap 'kill $daemon_pid' EXIT # Make sure we DON'T see the substitute. guile -c " @@ -77,3 +77,40 @@ guile -c " #:substitute-urls (list \"$GUIX_BINARY_SUBSTITUTE_URL\")) (exit (not (has-substitutes? store \"$out\")))" + +kill "$daemon_pid" + + +# Check the failed build cache. + +guix-daemon --no-substitutes --listen="$socket" --disable-chroot \ + --cache-failures & +daemon_pid=$! + +guile -c " + (use-modules (guix) (guix tests) (srfi srfi-34)) + (define store (open-connection-for-tests \"$socket\")) + + (define (build-without-failing drv) + (lambda (store) + (guard (c ((nix-protocol-error? c) (values #t store))) + (build-derivations store (list drv)) + (values #f store)))) + + ;; Make sure failed builds are cached and can be removed from + ;; the cache. + (run-with-store store + (mlet* %store-monad ((drv (gexp->derivation \"failure\" + #~(begin + (ungexp output) + #f))) + (out -> (derivation->output-path drv)) + (ok? (build-without-failing drv))) + ;; Note the mixture of monadic and direct style. Don't try + ;; this at home! + (return (exit (and ok? + (equal? (query-failed-paths store) (list out)) + (begin + (clear-failed-paths store (list out)) + (null? (query-failed-paths store))))))) + #:guile-for-build (%guile-for-build)) " |