diff options
| author | Christopher Baines <mail@cbaines.net> | 2022-12-15 12:12:12 +0000 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2022-12-15 12:12:12 +0000 |
| commit | adbf10109f681b2246a156db0b7e22ade4562c44 (patch) | |
| tree | 0d2407fbff3173ff2332027e1c5eae0e76eaa8e8 /guix-qa-frontpage | |
| parent | 1f9d7301af4d906cc995126d2aeb3bb8c35bd1d5 (diff) | |
| download | qa-frontpage-adbf10109f681b2246a156db0b7e22ade4562c44.tar qa-frontpage-adbf10109f681b2246a156db0b7e22ade4562c44.tar.gz | |
Start submitting builds for system tests
This'll enable getting system test information in to the data service, which
will in turn enable starting running system tests for patches when
appropriate.
Diffstat (limited to 'guix-qa-frontpage')
| -rw-r--r-- | guix-qa-frontpage/manage-builds.scm | 95 |
1 files changed, 94 insertions, 1 deletions
diff --git a/guix-qa-frontpage/manage-builds.scm b/guix-qa-frontpage/manage-builds.scm index 8be33ca..18e4b74 100644 --- a/guix-qa-frontpage/manage-builds.scm +++ b/guix-qa-frontpage/manage-builds.scm @@ -15,7 +15,8 @@ builds-missing-for-derivation-changes? start-submit-patch-builds-thread - start-submit-branch-builds-thread)) + start-submit-branch-builds-thread + start-submit-master-branch-system-tests-thread)) (define %systems-to-submit-builds-for '("x86_64-linux" @@ -391,3 +392,95 @@ (loop (cdr changes) builds-to-submit-details build-ids-to-keep-set)))))) + +(define %system-tests-that-change-every-revision + '("btrfs-raid10-root-os" + "btrfs-raid10-root-os-degraded" + "btrfs-raid-root-os" + "btrfs-root-on-subvolume-os" + "btrfs-root-os" + "docker-system" + "encrypted-home-os" + "encrypted-root-not-boot-os" + "encrypted-root-os" + "f2fs-root-os" + "gui-installed-desktop-os-encrypted" + "gui-installed-os" + "gui-installed-os-encrypted" + "gui-uefi-installed-os" + "installed-extlinux-os" + "installed-os" + "iso-image-installer" + "jfs-root-os" + "lvm-separate-home-os" + "raid-root-os" + "separate-home-os" + "separate-store-os" + "xfs-root-os")) + +(define (start-submit-master-branch-system-tests-thread database + build-coordinator + guix-data-service) + (define %systems + '("x86_64-linux" "aarch64-linux")) + + (define (submit-builds) + (simple-format #t "submitting system test builds\n") + (let* ((processed-revision-commits + (filter-map + (lambda (revision-details) + (if (assoc-ref revision-details "data_available") + (assoc-ref revision-details "commit-hash") + #f)) + (branch-revisions + (branch-revisions-url 2 "master")))) + (recent-processed-revision-commits + (if (> (length processed-revision-commits) + 5) + (take processed-revision-commits 5) + 5))) + + (for-each + (lambda (commit) + (for-each + (lambda (system) + (let* ((system-tests + (revision-system-tests + (revision-system-tests-url + commit #:system system)))) + (for-each + (lambda (system-test-details) + (let ((name + (assoc-ref system-test-details "name")) + (builds + (assoc-ref system-test-details "builds"))) + + (when (and (not + (member name + %system-tests-that-change-every-revision)) + (= (vector-length builds) 0)) + (submit-build build-coordinator + guix-data-service + (assoc-ref system-test-details "derivation"))))) + system-tests))) + %systems)) + recent-processed-revision-commits))) + + (call-with-new-thread + (lambda () + (while #t + (with-exception-handler + (lambda (exn) + (simple-format + (current-error-port) + "exception in submit system test builds thread: ~A\n" + exn)) + (lambda () + (with-throw-handler #t + submit-builds + (lambda args + (display (backtrace) (current-error-port)) + (newline (current-error-port))))) + #:unwind? #t) + + (sleep 3600))))) |