03/03: offload: Allow testing machines that match a regexp.

[Ludovic Courtès]

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")