2 files changed, 53 insertions(+), 1 deletions(-)

M guix/store.scm
M tests/guix-daemon.sh

@@ 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)

@@ 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)) "