summaryrefslogtreecommitdiff
path: root/bin
diff options
context:
space:
mode:
authorMathieu Lirzin <mthl@gnu.org>2016-07-24 17:48:03 +0200
committerMathieu Lirzin <mthl@gnu.org>2016-07-25 02:38:38 +0200
commitfccd6fa60b0a2345b5ea1c68ca07c443a03b7109 (patch)
tree0c55610dfa6f210d38b44b47e15a06965d262de4 /bin
parentefb249b056fe7ff6a4788de510cf6c344f20612c (diff)
downloadcuirass-fccd6fa60b0a2345b5ea1c68ca07c443a03b7109.tar
cuirass-fccd6fa60b0a2345b5ea1c68ca07c443a03b7109.tar.gz
evaluate: Store evaluations in evaluate script.
Diffstat (limited to 'bin')
-rw-r--r--bin/cuirass.in14
-rw-r--r--bin/evaluate.in29
2 files changed, 24 insertions, 19 deletions
diff --git a/bin/cuirass.in b/bin/cuirass.in
index fb4023c..5f89379 100644
--- a/bin/cuirass.in
+++ b/bin/cuirass.in
@@ -87,13 +87,11 @@ if required."
(assq-ref spec #:name) "/"
(assq-ref spec #:load-path))
(%package-cachedir)
- (object->string spec)))
+ (object->string spec)
+ (%package-database)))
(jobs (read port)))
(close-pipe port)
- ;; Keep track of SPEC id in the returned jobs.
- (let ((spec-id (assq-ref spec #:id)))
- (map (λ (job) (acons #:spec-id spec-id job))
- jobs))))
+ jobs))
(define (build-packages store db jobs)
"Build JOBS which is a list of <job> objects."
@@ -118,11 +116,7 @@ if required."
(compile (string-append (%package-cachedir) "/"
(assq-ref spec #:name)))
(with-store store
- (let* ((jobs (evaluate store db spec)))
- (for-each (λ (job)
- (or (evaluation-exists? db job)
- (db-add-evaluation db job)))
- jobs)
+ (let ((jobs (evaluate store db spec)))
(set-build-options store #:use-substitutes? #f)
(build-packages store db jobs))))
jobspecs))
diff --git a/bin/evaluate.in b/bin/evaluate.in
index 99124f3..878732f 100644
--- a/bin/evaluate.in
+++ b/bin/evaluate.in
@@ -24,6 +24,7 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
;;; along with Cuirass. If not, see <http://www.gnu.org/licenses/>.
(use-modules (cuirass base)
+ (cuirass database)
(cuirass utils)
(ice-9 match)
(ice-9 pretty-print)
@@ -31,7 +32,7 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
(define* (main #:optional (args (command-line)))
(match args
- ((command load-path cachedir specstr)
+ ((command load-path cachedir specstr database)
;; Load FILE, a Scheme file that defines Hydra jobs.
(let ((%user-module (make-fresh-user-module))
(spec (with-input-from-string specstr read))
@@ -54,15 +55,25 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
stderr)
(simple-format stderr "'build-things' arguments: ~S~%" args)
(exit 1)))
- ;; Call the entry point of FILE and print the resulting job sexp.
- (pretty-print
- (let* ((proc (module-ref %user-module 'hydra-jobs) )
- (thunks (proc store (assq-ref spec #:arguments))))
- (map (λ (thunk) (call-with-time-display thunk))
- thunks))
- stdout))))
+ (parameterize ((%package-database database))
+ ;; Call the entry point of FILE and print the resulting job sexp.
+ (let* ((proc (module-ref %user-module 'hydra-jobs))
+ (thunks (proc store (assq-ref spec #:arguments)))
+ (db (db-open))
+ (spec-id (assq-ref spec #:id)))
+ (pretty-print
+ (map (λ (thunk)
+ (let* ((job (call-with-time-display thunk))
+ ;; Keep track of SPEC id in the returned jobs.
+ (job* (acons #:spec-id spec-id job)))
+ (or (evaluation-exists? db job*)
+ (db-add-evaluation db job*))
+ job*))
+ thunks)
+ stdout)
+ (db-close db))))))
((command _ ...)
(simple-format (current-error-port) "Usage: ~A FILE
Evaluate the Hydra jobs defined in FILE.~%"
- command)
+ command)
(exit 1))))