mirrors
/
cuirass
mirror of https://notabug.org/mthl/cuirass.git
1
0
Fork 0
Code Issues Releases Wiki Activity

cuirass: Use always the same connection to the store. 

* bin/cuirass.in (evaluate): Add STORE argument.  Move 'open-connection'
call to ...
(main): ... here.
pull/3/head
Mathieu Lirzin 2016-06-12 00:28:21 +02:00
parent 64c64d8d71
commit b4c615fb73
No known key found for this signature in database
GPG Key ID: 0ADEE10094604D37
1 changed files with 26 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
bin/cuirass.in
View File

@ -82,7 +82,7 @@ DIR if required."
((guix-variable 'derivations 'build-derivations) store (list drv)))) ((guix-variable 'derivations 'build-derivations) store (list drv))))
jobs)) jobs))
(define (evaluate dir spec) (define (evaluate store dir spec)
"Evaluate and build package derivations in directory DIR." "Evaluate and build package derivations in directory DIR."
(save-module-excursion (save-module-excursion
(lambda () (lambda ()
@ -91,25 +91,19 @@ DIR if required."
(format #t "prepending ~s to the load path~%" guixdir) (format #t "prepending ~s to the load path~%" guixdir)
(set! %load-path (cons guixdir %load-path))) (set! %load-path (cons guixdir %load-path)))
(primitive-load spec))) (primitive-load spec)))
(let ((store ((guix-variable 'store 'open-connection)))) ((guix-variable 'store 'set-build-options) store
(dynamic-wind #:use-substitutes? #f)
(const #t) (build-packages
(lambda () store
((guix-variable 'store 'set-build-options) store (match ((module-ref %user-module 'hydra-jobs) store '())
#:use-substitutes? #f) (((names . thunks) ...)
(build-packages (map (lambda (job thunk)
store (format (current-error-port) "evaluating '~a'... " job)
(match ((module-ref %user-module 'hydra-jobs) store '()) (force-output (current-error-port))
(((names . thunks) ...) (make-job (symbol->string job)
(map (lambda (job thunk) (assoc-ref (call-with-time-display thunk)
(format (current-error-port) "evaluating '~a'... " job) 'derivation)))
(force-output (current-error-port)) names thunks)))))
(make-job (symbol->string job)
(assoc-ref (call-with-time-display thunk)
'derivation)))
names thunks)))))
(lambda ()
((guix-variable 'store 'close-connection) store)))))
;;; ;;;
@ -127,13 +121,19 @@ DIR if required."
(show-version progname) (show-version progname)
(exit 0)) (exit 0))
(else (else
(let* ((jobfile (option-ref opts 'file "tests/gnu-system.scm")) (let* ((store ((guix-variable 'store 'open-connection)))
(jobfile (option-ref opts 'file "tests/gnu-system.scm"))
(args (option-ref opts '() #f)) (args (option-ref opts '() #f))
(cachedir (if (null? args) (cachedir (if (null? args)
(getenv "CUIRASS_CACHEDIR") (getenv "CUIRASS_CACHEDIR")
(car args)))) (car args))))
(while #t (dynamic-wind
(pull-changes cachedir) (const #t)
(compile cachedir) (lambda ()
(evaluate cachedir jobfile) (while #t
(sleep (string->number (option-ref opts 'interval "60"))))))))) (pull-changes cachedir)
(compile cachedir)
(evaluate store cachedir jobfile)
(sleep (string->number (option-ref opts 'interval "60")))))
(lambda ()
((guix-variable 'store 'close-connection) store))))))))