guix/guix-cuirass
2
0
Fork 0
mirror of git://git.savannah.gnu.org/guix/guix-cuirass.git synced 2024-12-29 11:40:16 +01:00
Code Issues Releases Wiki Activity

Limit builds insertion queries.

Browse source 
Once the evaluation is over, the new builds are registered. This registration
tries to insert a new build for each derivation returned by the evaluation
phase. If the new build does not add a new output, the insertion query is then
rollbacked. This means that there are at least as many insertion queries as
new derivations.

SQlite allows at most one writer at a time, and even though we are using WAL
mode, performing a lot of insertions will reduce the reading perforances.
When multiple evaluations are performed in parallel, the large number of
concurrent insertion queries also causes contention.

To avoid those issues, check first in the "Outputs" table which derivations
are already registered. This means that most of the insertion queries will be
replaced by reading queries, that are much less expensive and more suitable
for Cuirass concurrent implementation.

* src/cuirass/base.scm (new-outputs?): New procedure.
(build-packages): Use it to insert only builds registering new outputs.
This commit is contained in:
Mathieu Othacehe 2020-09-25 11:00:11 +02:00
parent d1386d85ca
commit 461e07e14e
No known key found for this signature in database
GPG key ID: 8354763531769CA6
1 changed files with 27 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

42
src/cuirass/base.scm
View file

@ -694,6 +694,17 @@ by PRODUCT-SPECS."
(#:path . ,product))))))
product-specs))
(define (new-outputs? outputs)
"Return #t if OUTPUTS contains at least one unregistered output and #f
otherwise."
(let ((new-outputs
(filter-map (match-lambda
((name . path)
(let ((drv (db-get-output path)))
(and (not drv) path))))
outputs)))
(not (null? new-outputs))))
(define (build-packages store jobs eval-id)
"Build JOBS and return a list of Build results."
(define (register job)
@ -711,25 +722,26 @@ by PRODUCT-SPECS."
`(,name . ,path))))
(derivation-path->output-paths drv)))
(cur-time (time-second (current-time time-utc))))
(let ((build `((#:derivation . ,drv)
(#:eval-id . ,eval-id)
(#:job-name . ,job-name)
(#:system . ,system)
(#:nix-name . ,nix-name)
(and (new-outputs? outputs)
(let ((build `((#:derivation . ,drv)
(#:eval-id . ,eval-id)
(#:job-name . ,job-name)
(#:system . ,system)
(#:nix-name . ,nix-name)
;; XXX: We'd leave LOG to #f (i.e., NULL) but that
;; currently violates the non-NULL constraint.
(#:log . ,(or log ""))
;; XXX: We'd leave LOG to #f (i.e., NULL) but that
;; currently violates the non-NULL constraint.
(#:log . ,(or log ""))
(#:status . ,(build-status scheduled))
(#:outputs . ,outputs)
(#:timestamp . ,cur-time)
(#:starttime . 0)
(#:stoptime . 0))))
(db-add-build build))))
(#:status . ,(build-status scheduled))
(#:outputs . ,outputs)
(#:timestamp . ,cur-time)
(#:starttime . 0)
(#:stoptime . 0))))
(db-add-build build)))))
(define derivations
(filter-map register jobs))
(with-time-logging "registration" (filter-map register jobs)))
(log-message "evaluation ~a registered ~a new derivations"
eval-id (length derivations))