me
/
guix
Archived
1
0
Fork 0
Code

tests: cuirass: Add Cuirass remote test. 

* gnu/tests/cuirass.scm (run-cuirass-test): Add "name" and "remote-build?"
arguments.
(%cuirass-test): Adapt it.
(%cuirass-remote-test): New variable.
master
Mathieu Othacehe 2021-01-29 11:35:03 +01:00
parent a80d489227
commit df656c1518
No known key found for this signature in database
GPG Key ID: 8354763531769CA6
1 changed files with 53 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

74
gnu/tests/cuirass.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2020 Mathieu Othacehe <othacehe@gnu.org> ;;; Copyright © 2020, 2021 Mathieu Othacehe <othacehe@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -30,11 +30,13 @@
#:use-module (gnu services cuirass) #:use-module (gnu services cuirass)
#:use-module (gnu services databases) #:use-module (gnu services databases)
#:use-module (gnu services networking) #:use-module (gnu services networking)
#:use-module (gnu system nss)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix store) #:use-module (guix store)
#:export (%cuirass-test)) #:export (%cuirass-test
%cuirass-remote-test))
(define (run-cuirass-test) (define* (run-cuirass-test name #:key remote-build?)
(define %cuirass-specs (define %cuirass-specs
#~(list #~(list
'((#:name . "test") '((#:name . "test")
@ -93,6 +95,8 @@
(service cuirass-service-type (service cuirass-service-type
(cuirass-configuration (cuirass-configuration
(specifications %cuirass-specs) (specifications %cuirass-specs)
(remote-server (and remote-build?
(cuirass-remote-server-configuration)))
(host "0.0.0.0") (host "0.0.0.0")
(use-substitutes? #t))) (use-substitutes? #t)))
(service dhcp-client-service-type) (service dhcp-client-service-type)
@ -135,12 +139,25 @@
(guix build syscalls) (guix build syscalls)
(guix build utils)))) (guix build utils))))
(define os*
(operating-system
(inherit os)
(name-service-switch %mdns-host-lookup-nss)
(services
(append (if remote-build?
(list
(service avahi-service-type)
(service cuirass-remote-worker-service-type
(cuirass-remote-worker-configuration)))
'())
(operating-system-user-services os)))))
(define cuirass-web-port 8081) (define cuirass-web-port 8081)
(define forward-port 5000) (define forward-port 5000)
(define vm (define vm
(virtual-machine (virtual-machine
(operating-system os) (operating-system os*)
(memory-size 1024) (memory-size 1024)
(port-forwardings `((,forward-port . ,cuirass-web-port))))) (port-forwardings `((,forward-port . ,cuirass-web-port)))))
@ -169,13 +186,13 @@
(let loop ((attempt 1)) (let loop ((attempt 1))
(let ((result (f))) (let ((result (f)))
(cond (cond
(result result) (result result)
(else (else
(if (>= attempt times) (if (>= attempt times)
#f #f
(begin (begin
(sleep delay) (sleep delay)
(loop (+ 1 attempt))))))))) (loop (+ 1 attempt)))))))))
(mkdir #$output) (mkdir #$output)
(chdir #$output) (chdir #$output)
@ -205,12 +222,18 @@
(test-equal "cuirass-web evaluation" (test-equal "cuirass-web evaluation"
"test" "test"
(begin (begin
(let-values (((response text) (retry
(query "/api/evaluation?id=1"))) (lambda ()
(let ((result (let-values (((response text)
(json-string->scm (query "/api/evaluation?id=1")))
(utf8->string text)))) (let ((result
(assoc-ref result "specification"))))) (false-if-exception
(json-string->scm
(utf8->string text)))))
(and result
(assoc-ref result "specification")))))
#:times 5
#:delay 5)))
;; Even though there's a store overlay, the Guix database is not ;; Even though there's a store overlay, the Guix database is not
;; initialized, meaning that we won't be able to perform the ;; initialized, meaning that we won't be able to perform the
@ -226,8 +249,11 @@
(utf8->string text)))) (utf8->string text))))
(match (vector->list result) (match (vector->list result)
((build) ((build)
(string=? (assoc-ref build "job") (and (string=? (assoc-ref build "job")
"test-job")) "test-job")
(or (not #$remote-build?)
;; Check if the build is started.
(= (assoc-ref build "buildstatus") -1))))
(else #f))))) (else #f)))))
#:times 5 #:times 5
#:delay 5))) #:delay 5)))
@ -235,10 +261,16 @@
(test-end) (test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0)))))) (exit (= (test-runner-fail-count (test-runner-current)) 0))))))
(gexp->derivation "cuirass-test" test)) (gexp->derivation name test))
(define %cuirass-test (define %cuirass-test
(system-test (system-test
(name "cuirass") (name "cuirass")
(description "Connect to a Cuirass server.") (description "Connect to a Cuirass server.")
(value (run-cuirass-test)))) (value (run-cuirass-test name))))
(define %cuirass-remote-test
(system-test
(name "cuirass-remote")
(description "Connect to a Cuirass server with remote build.")
(value (run-cuirass-test name #:remote-build? #t))))