gnu: epiphany: Enable tests.

[jackhill/guix/guix.git] / tests / store.scm

diff --git a/tests/store.scm b/tests/store.scm
index 2b14a4a..0e80ccc 100644 (file)
--- 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,101 @@
          (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-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"
+                           (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))))
+    (with-build-handler (lambda (continue store things mode)
+                          (equal? (map derivation-file-name (list d1 d2))
+                                  things))
+      (map/accumulate-builds %store
+                             (lambda (drv)
+                               (build-derivations %store (list drv))
+                               (add-to-store %store "content-addressed"
+                                             #t "sha256"
+                                             (derivation->output-path drv)))
+                             (list d1 d2)))))
+
+(test-assert "mapm/accumulate-builds"
+  (let* ((d1 (run-with-store %store
+               (gexp->derivation "foo" #~(mkdir #$output))))
+         (d2 (run-with-store %store
+               (gexp->derivation "bar" #~(mkdir #$output)))))
+    (with-build-handler (lambda (continue store things mode)
+                          (equal? (map derivation-file-name (pk 'zz (list d1 d2)))
+                                  (pk 'XX things)))
+      (run-with-store %store
+        (mapm/accumulate-builds built-derivations `((,d1) (,d2)))))))
+
 (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)))