From 9a7e567bf2389de35d470ef8f8d6188b89442081 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 7 Nov 2018 15:10:09 +0100 Subject: 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))) -- cgit v1.2.3