aboutsummaryrefslogtreecommitdiff
path: root/guix-build-coordinator/build-allocator.scm
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2021-01-31 11:25:11 +0000
committerChristopher Baines <mail@cbaines.net>2021-01-31 11:25:11 +0000
commit6e27cf3c6bfb63fbd2c924cdd04e1fa73bdf2c00 (patch)
treea6aea442ee7359fab5236aa0303bb5ebec622c70 /guix-build-coordinator/build-allocator.scm
parent357613387f46e27a4fefa05b3516bbd47cec56d2 (diff)
downloadbuild-coordinator-6e27cf3c6bfb63fbd2c924cdd04e1fa73bdf2c00.tar
build-coordinator-6e27cf3c6bfb63fbd2c924cdd04e1fa73bdf2c00.tar.gz
Only require matching tags when the build and agent keys match
Diffstat (limited to 'guix-build-coordinator/build-allocator.scm')
-rw-r--r--guix-build-coordinator/build-allocator.scm28
1 files changed, 16 insertions, 12 deletions
diff --git a/guix-build-coordinator/build-allocator.scm b/guix-build-coordinator/build-allocator.scm
index 6c9588a..9246f52 100644
--- a/guix-build-coordinator/build-allocator.scm
+++ b/guix-build-coordinator/build-allocator.scm
@@ -38,18 +38,22 @@
(let ((build-tags (tags-for-build build-id)))
(every (match-lambda
((agent-key . agent-value)
- (any
- (match-lambda
- ((_ . build-value)
- (string=? agent-value build-value)))
- (vector-fold
- (lambda (_ result tag)
- (if (string=? (car tag)
- agent-key)
- (cons tag result)
- result))
- '()
- build-tags))))
+ (let ((matching-build-tags
+ (vector-fold
+ (lambda (_ result tag)
+ (if (string=? (car tag)
+ agent-key)
+ (cons tag result)
+ result))
+ '()
+ build-tags)))
+ (if (null? matching-build-tags)
+ #t
+ (any
+ (match-lambda
+ ((_ . build-value)
+ (string=? agent-value build-value)))
+ matching-build-tags)))))
(vector->list agent-tags))))))
(define* (basic-build-allocation-strategy datastore