[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
03/03: offload: Allow testing machines that match a regexp.
From: |
Ludovic Courtès |
Subject: |
03/03: offload: Allow testing machines that match a regexp. |
Date: |
Fri, 9 Dec 2016 22:30:25 +0000 (UTC) |
civodul pushed a commit to branch master
in repository guix.
commit 27991c97e64c95be4cae7f2b0a843565df329215
Author: Ludovic Courtès <address@hidden>
Date: Fri Dec 9 23:12:06 2016 +0100
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'.
---
doc/guix.texi | 6 ++++++
guix/scripts/offload.scm | 25 ++++++++++++++++---------
2 files changed, 22 insertions(+), 9 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 71de73b..0cb1bc7 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -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:
+
address@hidden
+# guix offload test machines.scm '\.gnu\.org$'
address@hidden example
@node Invoking guix-daemon
@section Invoking @command{guix-daemon}
diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm
index f56220f..c98cf8c 100644
--- a/guix/scripts/offload.scm
+++ b/guix/scripts/offload.scm
@@ -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")