guix/guix-cuirass
2
0
Fork 0
mirror of git://git.savannah.gnu.org/guix/guix-cuirass.git synced 2023-12-14 06:03:04 +01:00
Code Issues Releases Wiki Activity

schema: Evaluations: Add 'revision' column.

Browse source 
* src/schema.sql (Evaluations): Add 'revision' column.
* src/cuirass/database.scm (db-add-evaluation): Adapt.
All callers changed.
This commit is contained in:
Mathieu Lirzin 2016-07-27 19:19:26 +02:00
parent ad267dc86a
commit ac4512897c
No known key found for this signature in database
GPG key ID: 0ADEE10094604D37
5 changed files with 18 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
bin/evaluate.in
View file

@ -60,8 +60,10 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
(let* ((proc (module-ref %user-module 'hydra-jobs)) (let* ((proc (module-ref %user-module 'hydra-jobs))
(thunks (proc store (assq-ref spec #:arguments))) (thunks (proc store (assq-ref spec #:arguments)))
(db (db-open)) (db (db-open))
(spec-id (assq-ref spec #:id)) (commit (assq-ref spec #:current-commit))
(eval-id (db-add-evaluation db spec-id))) (eval `((#:specification . ,(assq-ref spec #:id))
(#:revision . ,commit)))
(eval-id (db-add-evaluation db eval)))
(pretty-print (pretty-print
(map (λ (thunk) (map (λ (thunk)
(let* ((job (call-with-time-display thunk)) (let* ((job (call-with-time-display thunk))

3
src/cuirass/base.scm
View file

@ -147,7 +147,8 @@ if required."
(compile (string-append (%package-cachedir) "/" (compile (string-append (%package-cachedir) "/"
(assq-ref spec #:name))) (assq-ref spec #:name)))
(with-store store (with-store store
(let ((jobs (evaluate store db spec))) (let* ((spec* (acons #:current-commit commit spec))
(jobs (evaluate store db spec*)))
(set-build-options store #:use-substitutes? #f) (set-build-options store #:use-substitutes? #f)
(build-packages store db jobs)))) (build-packages store db jobs))))
(db-add-stamp db spec commit))) (db-add-stamp db spec commit)))

8
src/cuirass/database.scm
View file

@ -155,9 +155,11 @@ INSERT INTO Derivations (derivation, job_name, evaluation)\
"Retrieve a job in database DB which corresponds to ID." "Retrieve a job in database DB which corresponds to ID."
(car (sqlite-exec db "SELECT * FROM Derivations WHERE derivation='~A';" id))) (car (sqlite-exec db "SELECT * FROM Derivations WHERE derivation='~A';" id)))
(define (db-add-evaluation db spec-id) (define (db-add-evaluation db eval)
(sqlite-exec db "INSERT INTO Evaluations (specification) VALUES ('~A');" (sqlite-exec db "\
spec-id) INSERT INTO Evaluations (specification, revision) VALUES ('~A', '~A');"
(assq-ref eval #:specification)
(assq-ref eval #:revision))
(last-insert-rowid db)) (last-insert-rowid db))
(define-syntax-rule (with-database db body ...) (define-syntax-rule (with-database db body ...)

1
src/schema.sql
View file

@ -23,6 +23,7 @@ CREATE TABLE Stamps (
CREATE TABLE Evaluations ( CREATE TABLE Evaluations (
id INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT, id INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT,
specification INTEGER NOT NULL, specification INTEGER NOT NULL,
revision TEXT NOT NULL,
FOREIGN KEY (specification) REFERENCES Specifications (id) FOREIGN KEY (specification) REFERENCES Specifications (id)
); );

12
tests/database.scm
View file

@ -59,12 +59,12 @@
(test-assert "sqlite-exec" (test-assert "sqlite-exec"
(begin (begin
(sqlite-exec (%db) (sqlite-exec (%db) "\
"INSERT INTO Evaluations (specification) VALUES (1);") INSERT INTO Evaluations (specification, revision) VALUES (1, 1);")
(sqlite-exec (%db) (sqlite-exec (%db) "\
"INSERT INTO Evaluations (specification) VALUES (2);") INSERT INTO Evaluations (specification, revision) VALUES (2, 2);")
(sqlite-exec (%db) (sqlite-exec (%db) "\
"INSERT INTO Evaluations (specification) VALUES (3);") INSERT INTO Evaluations (specification, revision) VALUES (3, 3);")
(sqlite-exec (%db) "SELECT * FROM Evaluations;"))) (sqlite-exec (%db) "SELECT * FROM Evaluations;")))
(test-equal "db-add-specification" (test-equal "db-add-specification"