[no subject]

[Ludovic Courtès]

branch: master
commit e2123ab89662beecad0901f55b42b3c5e916cab0
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Fri Jul 14 15:07:32 2023 +0200

    examples: Add jobset that builds "random" jobs.
    
    * examples/random-manifest.scm, examples/random.scm: New files.
    * Makefile.am (EXTRA_DIST): Add them.
---
 Makefile.am                  |  2 ++
 examples/random-manifest.scm | 65 ++++++++++++++++++++++++++++++++++++++++++++
 examples/random.scm          | 14 ++++++++++
 3 files changed, 81 insertions(+)

diff --git a/Makefile.am b/Makefile.am
index e9dabe5..6ac8e81 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -203,6 +203,8 @@ EXTRA_DIST =                                        \
   etc/cuirass-remote-worker.service.in         \
   examples/hello.scm                           \
   examples/cuirass.scm                         \
+  examples/random.scm                          \
+  examples/random-manifest.scm                 \
   $(TESTS)
 
 dist-hook:
diff --git a/examples/random-manifest.scm b/examples/random-manifest.scm
new file mode 100644
index 0000000..e8e2d0d
--- /dev/null
+++ b/examples/random-manifest.scm
@@ -0,0 +1,65 @@
+;;; random-manifest.scm -- Return a manifest of random entries.
+;;; Copyright © 2018, 2023 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
+;;;
+;;; This file is part of Cuirass.
+;;;
+;;; Cuirass is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; Cuirass is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Cuirass.  If not, see <http://www.gnu.org/licenses/>.
+
+(use-modules (guix)
+             (guix profiles)
+             (srfi srfi-1)
+             (srfi srfi-26))
+
+(define (make-job name lowerable)
+  (manifest-entry
+    (name name)
+    (version "0")
+    (item lowerable)))
+
+(define %seed
+  (logxor (cdr (gettimeofday))
+          (car (gettimeofday))
+          (cdr (gettimeofday))))
+
+(define %state
+  (seed->random-state %seed))
+
+(define* (random-computed-file #:optional (suffix ""))
+  (let ((nonce (random 1e6 %state)))
+    (computed-file (string-append "random" suffix)
+                   #~(let ((delay #$(random 60 %state))
+                           (fail? #$(zero? (random 4 %state))))
+                       (setvbuf (current-output-port) 'line)
+                       (setvbuf (current-error-port) 'line)
+
+                       (display "Starting build!\n")
+                       (sleep (pk 'sleeping delay))
+                       (when fail?
+                         (error "we're faillliiiiing!"))
+                       #$nonce
+                       (mkdir #$output)))))
+
+
+(when (zero? (random 7 %state))
+  (error "Evaluation is failing!"))
+
+(manifest
+ (unfold (cut > <> 10)
+         (lambda (i)
+           (let ((suffix (number->string i)))
+             (make-job (string-append "entropy-" suffix)
+                       (random-computed-file suffix))))
+         1+
+         0))
diff --git a/examples/random.scm b/examples/random.scm
new file mode 100644
index 0000000..28fccce
--- /dev/null
+++ b/examples/random.scm
@@ -0,0 +1,14 @@
+;; This spec builds the manifest from 'examples/random-manifest.scm', which is
+;; possible because Cuirass itself is a channel.  This is a useful way to test
+;; Cuirass itself and its build mechanism.
+
+(list (specification
+       (name 'random)
+       (build '(manifests "examples/random-manifest.scm"))
+       (channels
+        (cons (channel
+               (name 'cuirass)
+               (url (canonicalize-path
+                     (string-append (dirname (current-filename))
+                                    "/.."))))
+              %default-channels))))