offload: Allow testing machines that match a regexp.
* guix/scripts/offload.scm (check-machine-availability): Add 'pred' parameter and honor it. (guix-offload): for the "test" sub-command, accept an extra 'regexp' parameter. Pass a second argument to 'check-machine-availability'.
This commit is contained in:
parent
2b513387cd
commit
27991c97e6
@ -1005,6 +1005,12 @@ command line:
|
||||
# guix offload test machines-qualif.scm
|
||||
@end example
|
||||
|
||||
Last, you can test the subset of the machines whose name matches a
|
||||
regular expression like this:
|
||||
|
||||
@example
|
||||
# guix offload test machines.scm '\.gnu\.org$'
|
||||
@end example
|
||||
|
||||
@node Invoking guix-daemon
|
||||
@section Invoking @command{guix-daemon}
|
||||
|
@ -708,16 +708,18 @@ allowed on MACHINE. Return +∞ if MACHINE is unreachable."
|
||||
(leave (_ "failed to import '~a' from '~a'~%")
|
||||
item name)))))
|
||||
|
||||
(define (check-machine-availability machine-file)
|
||||
"Check that each machine in MACHINE-FILE is usable as a build machine."
|
||||
(define (check-machine-availability machine-file pred)
|
||||
"Check that each machine matching PRED in MACHINE-FILE is usable as a build
|
||||
machine."
|
||||
(define (build-machine=? m1 m2)
|
||||
(and (string=? (build-machine-name m1) (build-machine-name m2))
|
||||
(= (build-machine-port m1) (build-machine-port m2))))
|
||||
|
||||
;; A given build machine may appear several times (e.g., once for
|
||||
;; "x86_64-linux" and a second time for "i686-linux"); test them only once.
|
||||
(let ((machines (delete-duplicates (build-machines machine-file)
|
||||
build-machine=?)))
|
||||
(let ((machines (filter pred
|
||||
(delete-duplicates (build-machines machine-file)
|
||||
build-machine=?))))
|
||||
(info (_ "testing ~a build machines defined in '~a'...~%")
|
||||
(length machines) machine-file)
|
||||
(let* ((names (map build-machine-name machines))
|
||||
@ -781,11 +783,16 @@ allowed on MACHINE. Return +∞ if MACHINE is unreachable."
|
||||
(loop (read-line)))))))
|
||||
(("test" rest ...)
|
||||
(with-error-handling
|
||||
(let ((file (match rest
|
||||
((file) file)
|
||||
(() %machine-file)
|
||||
(_ (leave (_ "wrong number of arguments~%"))))))
|
||||
(check-machine-availability (or file %machine-file)))))
|
||||
(let-values (((file pred)
|
||||
(match rest
|
||||
((file regexp)
|
||||
(values file
|
||||
(compose (cut string-match regexp <>)
|
||||
build-machine-name)))
|
||||
((file) (values file (const #t)))
|
||||
(() (values %machine-file (const #t)))
|
||||
(_ (leave (_ "wrong number of arguments~%"))))))
|
||||
(check-machine-availability (or file %machine-file) pred))))
|
||||
(("--version")
|
||||
(show-version-and-exit "guix offload"))
|
||||
(("--help")
|
||||
|
Loading…
Reference in New Issue
Block a user