[no subject]

[Ludovic Courtès]

branch: master
commit 9a7e567bf2389de35d470ef8f8d6188b89442081
Author: Ludovic Courtès <address@hidden>
Date:   Wed Nov 7 15:10:09 2018 +0100

    examples: random: Fail evaluation once in a while.
    
    * examples/random-jobs.scm (make-random-jobs): Fail once in a while.
    (%seed, %state): New variables.
    (random-derivation): Use %SEED.
---
 examples/random-jobs.scm | 17 +++++++++++++----
 1 file changed, 13 insertions(+), 4 deletions(-)

diff --git a/examples/random-jobs.scm b/examples/random-jobs.scm
index d623b25..e820c0a 100644
--- a/examples/random-jobs.scm
+++ b/examples/random-jobs.scm
@@ -30,20 +30,26 @@
       (#:description "dummy job")
       (#:long-description "really dummy job"))))
 
+(define %seed
+  (logxor (cdr (gettimeofday))
+          (car (gettimeofday))
+          (cdr (gettimeofday))))
+
+(define %state
+  (seed->random-state %seed))
+
 (define* (random-derivation store #:optional (suffix ""))
   (let ((nonce (random 1e6)))
     (run-with-store store
       (gexp->derivation (string-append "random" suffix)
-                        #~(let* ((seed  (logxor #$(cdr (gettimeofday))
-                                                (car (gettimeofday))
-                                                (cdr (gettimeofday))))
-                                 (state (seed->random-state seed)))
+                        #~(let ((state (seed->random-state #$%seed)))
                             (sleep (pk 'sleeping (random 10 state)))
                             (when (zero? (random 4 state))
                               (error "we're faillliiiiing!"))
                             #$nonce
                             (mkdir #$output))))))
 
+
 (define (make-random-jobs store arguments)
   (let ((checkout (assq-ref arguments 'cuirass)))
     (format (current-error-port)
@@ -51,6 +57,9 @@
             (assq-ref checkout 'file-name)
             (assq-ref checkout 'revision)))
 
+  (when (zero? (random 7 %state))
+    (error "Evaluation is failing!"))
+
   (unfold (cut > <> 10)
           (lambda (i)
             (let ((suffix (number->string i)))