summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorMarius Bakke <mbakke@fastmail.com>2018-10-17 20:47:11 +0200
committerMarius Bakke <mbakke@fastmail.com>2018-10-17 20:47:11 +0200
commitd02bb02f7d833ad371c53c346b6cb77f01377cf4 (patch)
tree9506f04a7fde2f3b264ba1d2a9012085e1f72b72 /tests
parentfb3ff265cd8c6b4c6160f94240dc8932097e637b (diff)
parentacce0a474c1493ab18912bc46285248e4ccb0314 (diff)
downloadpatches-d02bb02f7d833ad371c53c346b6cb77f01377cf4.tar
patches-d02bb02f7d833ad371c53c346b6cb77f01377cf4.tar.gz
Merge branch 'master' into core-updates
Diffstat (limited to 'tests')
-rw-r--r--tests/guix-build.sh4
-rw-r--r--tests/status.scm70
-rw-r--r--tests/store.scm63
3 files changed, 136 insertions, 1 deletions
diff --git a/tests/guix-build.sh b/tests/guix-build.sh
index 92e7299321..7842ce87c6 100644
--- a/tests/guix-build.sh
+++ b/tests/guix-build.sh
@@ -221,6 +221,10 @@ guix build -e "(begin
guix build -e '#~(mkdir #$output)' -d
guix build -e '#~(mkdir #$output)' -d | grep 'gexp\.drv'
+# Same with a file-like object.
+guix build -e '(computed-file "foo" #~(mkdir #$output))' -d
+guix build -e '(computed-file "foo" #~(mkdir #$output))' -d | grep 'foo\.drv'
+
# Building from a package file.
cat > "$module_dir/package.scm"<<EOF
(use-modules (gnu))
diff --git a/tests/status.scm b/tests/status.scm
index 04dedb702c..99abb41c8b 100644
--- a/tests/status.scm
+++ b/tests/status.scm
@@ -20,7 +20,10 @@
#:use-module (guix status)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
- #:use-module (srfi srfi-64))
+ #:use-module (srfi srfi-64)
+ #:use-module (rnrs bytevectors)
+ #:use-module (rnrs io ports)
+ #:use-module (ice-9 match))
(test-begin "status")
@@ -112,4 +115,69 @@
(display "@ substituter-succeeded baz\n" port)
(list first (get-status)))))
+(test-equal "build-output-port, UTF-8"
+ '((build-log #f "lambda is λ!\n"))
+ (let-values (((port get-status) (build-event-output-port cons '()))
+ ((bv) (string->utf8 "lambda is λ!\n")))
+ (put-bytevector port bv)
+ (force-output port)
+ (get-status)))
+
+(test-equal "current-build-output-port, UTF-8 + garbage"
+ ;; What about a mixture of UTF-8 + garbage?
+ (let ((replacement (cond-expand
+ ((and guile-2 (not guile-2.2)) "?")
+ (else "�"))))
+ `((build-log #f ,(string-append "garbage: " replacement "lambda: λ\n"))))
+ (let-values (((port get-status) (build-event-output-port cons '())))
+ (display "garbage: " port)
+ (put-bytevector port #vu8(128))
+ (put-bytevector port (string->utf8 "lambda: λ\n"))
+ (force-output port)
+ (get-status)))
+
+(test-equal "compute-status, multiplexed build output"
+ (list (build-status
+ (building '("foo.drv"))
+ (downloading (list (download "bar" "http://example.org/bar"
+ #:size 999
+ #:start 'now))))
+ (build-status
+ (building '("foo.drv"))
+ (downloading (list (download "bar" "http://example.org/bar"
+ #:size 999
+ #:transferred 42
+ #:start 'now))))
+ (build-status
+ ;; XXX: Should "bar.drv" be present twice?
+ (builds-completed '("bar.drv" "foo.drv"))
+ (downloads-completed (list (download "bar" "http://example.org/bar"
+ #:size 999
+ #:transferred 999
+ #:start 'now
+ #:end 'now)))))
+ (let-values (((port get-status)
+ (build-event-output-port (lambda (event status)
+ (compute-status event status
+ #:current-time
+ (const 'now)
+ #:derivation-path->output-path
+ (match-lambda
+ ("bar.drv" "bar")))))))
+ (display "@ build-started foo.drv 121\n" port)
+ (display "@ build-started bar.drv 144\n" port)
+ (display "@ build-log 121 6\nHello!" port)
+ (display "@ build-log 144 50
+@ download-started bar http://example.org/bar 999\n" port)
+ (let ((first (get-status)))
+ (display "@ build-log 121 30\n@ build-started FAKE!.drv 555\n")
+ (display "@ build-log 144 54
+@ download-progress bar http://example.org/bar 999 42\n"
+ port)
+ (let ((second (get-status)))
+ (display "@ download-succeeded bar http://example.org/bar 999\n" port)
+ (display "@ build-succeeded foo.drv\n" port)
+ (display "@ build-succeeded bar.drv\n" port)
+ (list first second (get-status))))))
+
(test-end "status")
diff --git a/tests/store.scm b/tests/store.scm
index 2858369706..3ff526cdcf 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -31,6 +31,7 @@
#:use-module (gnu packages)
#:use-module (gnu packages bootstrap)
#:use-module (ice-9 match)
+ #:use-module (ice-9 regex)
#:use-module (rnrs bytevectors)
#:use-module (rnrs io ports)
#:use-module (web uri)
@@ -1021,4 +1022,66 @@
(call-with-input-file (derivation->output-path drv2)
read))))))
+(test-equal "multiplexed-build-output"
+ '("Hello from first." "Hello from second.")
+ (with-store store
+ (let* ((build (add-text-to-store store "build.sh"
+ "echo Hello from $NAME.; echo > $out"))
+ (bash (add-to-store store "bash" #t "sha256"
+ (search-bootstrap-binary "bash"
+ (%current-system))))
+ (drv1 (derivation store "one" bash
+ `("-e" ,build)
+ #:inputs `((,bash) (,build))
+ #:env-vars `(("NAME" . "first")
+ ("x" . ,(random-text)))))
+ (drv2 (derivation store "two" bash
+ `("-e" ,build)
+ #:inputs `((,bash) (,build))
+ #:env-vars `(("NAME" . "second")
+ ("x" . ,(random-text))))))
+ (set-build-options store
+ #:print-build-trace #t
+ #:multiplexed-build-output? #t
+ #:max-build-jobs 10)
+ (let ((port (open-output-string)))
+ ;; Send the build log to PORT.
+ (parameterize ((current-build-output-port port))
+ (build-derivations store (list drv1 drv2)))
+
+ ;; Retrieve the build log; make sure it contains valid "@ build-log"
+ ;; traces that allow us to retrieve each builder's output (we assume
+ ;; there's exactly one "build-output" trace for each builder, which is
+ ;; reasonable.)
+ (let* ((log (get-output-string port))
+ (started (fold-matches
+ (make-regexp "@ build-started ([^ ]+) - ([^ ]+) ([^ ]+) ([0-9]+)")
+ log '() cons))
+ (done (fold-matches
+ (make-regexp "@ build-succeeded (.*) - (.*) (.*) (.*)")
+ log '() cons))
+ (output (fold-matches
+ (make-regexp "@ build-log ([[:digit:]]+) ([[:digit:]]+)\n([A-Za-z .*]+)\n")
+ log '() cons))
+ (drv-pid (lambda (name)
+ (lambda (m)
+ (let ((drv (match:substring m 1))
+ (pid (string->number
+ (match:substring m 4))))
+ (and (string-suffix? name drv) pid)))))
+ (pid-log (lambda (pid)
+ (lambda (m)
+ (let ((n (string->number
+ (match:substring m 1)))
+ (len (string->number
+ (match:substring m 2)))
+ (str (match:substring m 3)))
+ (and (= pid n)
+ (= (string-length str) (- len 1))
+ str)))))
+ (pid1 (any (drv-pid "one.drv") started))
+ (pid2 (any (drv-pid "two.drv") started)))
+ (list (any (pid-log pid1) output)
+ (any (pid-log pid2) output)))))))
+
(test-end "store")