diff options
| -rw-r--r-- | Makefile.am | 3 | ||||
| -rw-r--r-- | bin/cuirass.in | 6 | ||||
| -rw-r--r-- | bin/evaluate.in | 4 | ||||
| -rw-r--r-- | doc/cuirass.texi | 33 | ||||
| -rw-r--r-- | src/cuirass/base.scm | 49 | ||||
| -rw-r--r-- | src/cuirass/database.scm | 105 | ||||
| -rw-r--r-- | src/cuirass/templates.scm | 35 | ||||
| -rw-r--r-- | src/schema.sql | 16 | ||||
| -rw-r--r-- | src/sql/upgrade-3.sql | 46 | ||||
| -rw-r--r-- | tests/database.scm | 31 | ||||
| -rw-r--r-- | tests/http.scm | 55 |
11 files changed, 266 insertions, 117 deletions
diff --git a/Makefile.am b/Makefile.am index db56165..2f83659 100644 --- a/Makefile.am +++ b/Makefile.am @@ -66,7 +66,8 @@ dist_pkgdata_DATA = src/schema.sql dist_sql_DATA = \ src/sql/upgrade-1.sql \ - src/sql/upgrade-2.sql + src/sql/upgrade-2.sql \ + src/sql/upgrade-3.sql dist_css_DATA = \ src/static/css/bootstrap.css \ diff --git a/bin/cuirass.in b/bin/cuirass.in index d30f788..a7af5b2 100644 --- a/bin/cuirass.in +++ b/bin/cuirass.in @@ -129,6 +129,12 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@" (clear-build-queue) + ;; If Cuirass was stopped during an evaluation, consider + ;; it done. Builds that were not registered during this + ;; evaluation will be registered during the next + ;; evaluation. + (db-set-evaluations-done) + ;; First off, restart builds that had not completed or ;; were not even started on a previous run. (spawn-fiber diff --git a/bin/evaluate.in b/bin/evaluate.in index 3f08b92..19d0f12 100644 --- a/bin/evaluate.in +++ b/bin/evaluate.in @@ -44,7 +44,7 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@" (define (input-checkout checkouts input-name) "Find in CHECKOUTS the CHECKOUT corresponding to INPUT-NAME, and return it." (find (lambda (checkout) - (string=? (assq-ref checkout #:name) + (string=? (assq-ref checkout #:input) input-name)) checkouts)) @@ -91,7 +91,7 @@ entries are added because they could be useful during the evaluation." (match in (() (cons name out)) - (((#:name . val) . rest) + (((#:input . val) . rest) (loop rest out (string->symbol val))) (((#:directory . val) . rest) (loop rest (cons `(file-name . ,val) out) name)) diff --git a/doc/cuirass.texi b/doc/cuirass.texi index b51cfad..08ca832 100644 --- a/doc/cuirass.texi +++ b/doc/cuirass.texi @@ -249,7 +249,7 @@ Cuirass uses a SQLite database to store information about jobs and past build results, but also to coordinate the execution of jobs. The database contains the following tables: @code{Specifications}, -@code{Inputs}, @code{Stamps}, @code{Evaluations}, @code{Builds} and +@code{Inputs}, @code{Checkouts}, @code{Evaluations}, @code{Builds} and @code{Outputs}. The purpose of each of these tables is explained below. @section Specifications @@ -334,16 +334,33 @@ When this integer field holds the value @code{1} Cuirass will skip compilation for the specified repository. @end table -@section Stamps -@cindex stamps, database +@section Checkouts +@cindex checkouts, database When a specification is processed, the repositories must be downloaded at a -certain revision as specified. The @code{Stamps} table stores the current -revisions for every specification when it is being processed. +certain revision as specified. The download is called a checkout. The +@code{Checkouts} table stores the new checkouts for every specification when +it is being processed. -The table only has two text columns: @code{specification}, which references a -specification from the @code{Specifications} table via the field @code{name}, -and @code{stamp}, which holds the revisions (space separated commit hashes). +The @code{Checkouts} table has the following columns: + +@table @code +@item specification +The specification associated with the checkout. + +@item revision +The revision of the checkout. Within the same specification, two checkouts +can't be identical: they can't have the same revision. + +@item evaluation +The evaluation that was triggered by the addition of that new checkout. + +@item input +The input associated with the checkout. + +@item directory +The directory into which the checkout was extracted. +@end table @section Evaluations @cindex evaluations, database diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm index 1ec122c..deee05b 100644 --- a/src/cuirass/base.scm +++ b/src/cuirass/base.scm @@ -178,7 +178,7 @@ read-only directory." (string-append (%package-cachedir) "/" name)) directory))) - `((#:name . ,name) + `((#:input . ,name) (#:directory . ,directory) (#:commit . ,commit) (#:load-path . ,(assq-ref input #:load-path)) @@ -248,10 +248,10 @@ fibers." (logior (@ (fibers epoll) EPOLLERR) (@ (fibers epoll) EPOLLHUP))))) -(define (evaluate store spec checkouts commits) +(define (evaluate store spec eval-id checkouts) "Evaluate and build package derivations defined in SPEC, using CHECKOUTS. -Return a list of jobs." - (define (augment-job job eval-id) +Return a list of jobs that are associated to EVAL-ID." + (define (augment-job job) (let ((drv (read-derivation-from-file (assq-ref job #:derivation)))) `((#:eval-id . ,eval-id) @@ -275,14 +275,9 @@ Return a list of jobs." (close-pipe port) (match result (('evaluation jobs) - (let* ((spec-name (assq-ref spec #:name)) - (eval-id (db-add-evaluation - `((#:specification . ,spec-name) - (#:commits . ,commits))))) - (log-message "created evaluation ~a for '~a'" eval-id spec-name) - (map (lambda (job) - (augment-job job eval-id)) - jobs)))))) + (let* ((spec-name (assq-ref spec #:name))) + (log-message "evaluation ~a for '~a' completed" eval-id spec-name) + (map augment-job jobs)))))) ;;; @@ -539,7 +534,7 @@ started)." (spawn-builds store valid) (log-message "done with restarted builds")))) -(define (build-packages store jobs) +(define (build-packages store jobs eval-id) "Build JOBS and return a list of Build results." (define (register job) (let* ((name (assq-ref job #:job-name)) @@ -576,6 +571,10 @@ started)." (define derivations (filter-map register jobs)) + (log-message "evaluation ~a registered ~a new derivations" + eval-id (length derivations)) + (db-set-evaluation-done eval-id) + (spawn-builds store derivations) (let* ((results (filter-map (cut db-get-build <>) derivations)) @@ -625,7 +624,7 @@ started)." (results (par-map %non-blocking thunks))) (map (lambda (checkout) (log-message "fetched input '~a' of spec '~a' (commit ~s)" - (assq-ref checkout #:name) + (assq-ref checkout #:input) (assq-ref spec #:name) (assq-ref checkout #:commit)) checkout) @@ -638,7 +637,7 @@ started)." (lambda (checkout) (lambda () (log-message "compiling input '~a' of spec '~a' (commit ~s)" - (assq-ref checkout #:name) + (assq-ref checkout #:input) (assq-ref spec #:name) (assq-ref checkout #:commit)) (compile checkout))) @@ -646,7 +645,7 @@ started)." (results (par-map %non-blocking thunks))) (map (lambda (checkout) (log-message "compiled input '~a' of spec '~a' (commit ~s)" - (assq-ref checkout #:name) + (assq-ref checkout #:input) (assq-ref spec #:name) (assq-ref checkout #:commit)) checkout) @@ -656,15 +655,10 @@ started)." "Evaluate and build JOBSPECS and store results in the database." (define (process spec) (with-store store - (let* ((stamp (db-get-stamp spec)) - (name (assoc-ref spec #:name)) + (let* ((name (assoc-ref spec #:name)) (checkouts (fetch-inputs spec)) - (commits (map (cut assq-ref <> #:commit) checkouts)) - (commits-str (string-join commits))) - (unless (equal? commits-str stamp) - ;; Immediately mark SPEC's INPUTS as being processed so we don't - ;; spawn a concurrent evaluation of that same commit. - (db-add-stamp spec commits-str) + (eval-id (db-add-evaluation name checkouts))) + (when eval-id (compile-checkouts spec (filter compile? checkouts)) (spawn-fiber (lambda () @@ -672,13 +666,12 @@ started)." (log-message "failed to evaluate spec '~a'" (evaluation-error-spec-name c)) #f)) - (log-message "evaluating spec '~a': stamp ~s different from ~s" - name commits-str stamp) + (log-message "evaluating spec '~a'" name) (with-store store - (let ((jobs (evaluate store spec checkouts commits))) + (let ((jobs (evaluate store spec eval-id checkouts))) (log-message "building ~a jobs for '~a'" (length jobs) name) - (build-packages store jobs)))))) + (build-packages store jobs eval-id)))))) ;; 'spawn-fiber' returns zero values but we need one. *unspecified*)))) diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm index 912039e..6777d28 100644 --- a/src/cuirass/database.scm +++ b/src/cuirass/database.scm @@ -38,9 +38,9 @@ db-close db-add-specification db-get-specifications - db-add-stamp - db-get-stamp db-add-evaluation + db-set-evaluations-done + db-set-evaluation-done db-get-pending-derivations build-status db-add-build @@ -265,6 +265,29 @@ tag, revision, no_compile_p) VALUES (" (if (assq-ref input #:no-compile?) 1 0) ");") (last-insert-rowid db))) +(define (db-add-checkout spec-name eval-id checkout) + "Insert CHECKOUT associated with SPEC-NAME and EVAL-ID. If a checkout with +the same revision already exists for SPEC-NAME, return #f." + (with-db-critical-section db + (catch 'sqlite-error + (lambda () + (sqlite-exec db "\ +INSERT INTO Checkouts (specification, revision, evaluation, input, +directory) VALUES (" + spec-name ", " + (assq-ref checkout #:commit) ", " + eval-id ", " + (assq-ref checkout #:input) ", " + (assq-ref checkout #:directory) ");") + (last-insert-rowid db)) + (lambda (key who code message . rest) + ;; If we get a unique-constraint-failed error, that means we have + ;; already inserted the same checkout. That happens for each input + ;; that doesn't change between two evaluations. + (if (= code SQLITE_CONSTRAINT_PRIMARYKEY) + #f + (apply throw key who code rest)))))) + (define (db-add-specification spec) "Store SPEC in database the database. SPEC inputs are stored in the INPUTS table." @@ -328,13 +351,31 @@ package_path_inputs, proc_input, proc_file, proc, proc_args) \ (#:inputs . ,(db-get-inputs name))) specs))))))) -(define (db-add-evaluation eval) +(define (db-add-evaluation spec-name checkouts) + "Add a new evaluation for SPEC-NAME only if one of the CHECKOUTS is new. +Otherwise, return #f." (with-db-critical-section db - (sqlite-exec db "\ -INSERT INTO Evaluations (specification, commits) VALUES (" - (assq-ref eval #:specification) ", " - (string-join (assq-ref eval #:commits)) ");") - (last-insert-rowid db))) + (sqlite-exec db "BEGIN TRANSACTION;") + (sqlite-exec db "INSERT INTO Evaluations (specification, in_progress) +VALUES (" spec-name ", true);") + (let* ((eval-id (last-insert-rowid db)) + (new-checkouts (filter-map + (cut db-add-checkout spec-name eval-id <>) + checkouts))) + (if (null? new-checkouts) + (begin (sqlite-exec db "ROLLBACK;") + #f) + (begin (sqlite-exec db "COMMIT;") + eval-id))))) + +(define (db-set-evaluations-done) + (with-db-critical-section db + (sqlite-exec db "UPDATE Evaluations SET in_progress = false;"))) + +(define (db-set-evaluation-done eval-id) + (with-db-critical-section db + (sqlite-exec db "UPDATE Evaluations SET in_progress = false +WHERE id = " eval-id ";"))) (define-syntax-rule (with-database body ...) "Run BODY with %DB-CHANNEL being dynamically bound to a channel implementing @@ -568,46 +609,44 @@ the database. The returned list is guaranteed to not have any duplicates." (sqlite-exec db " SELECT derivation FROM Builds WHERE Builds.status < 0;")))) -(define (db-get-stamp spec) - "Return a stamp corresponding to specification SPEC in the database." - (with-db-critical-section db - (let ((res (sqlite-exec db "SELECT * FROM Stamps WHERE specification=" - (assq-ref spec #:name) ";"))) - (match res - (() #f) - ((#(spec stamp)) stamp))))) - -(define (db-add-stamp spec stamp) - "Associate STAMP to specification SPEC in the database." +(define (db-get-checkouts eval-id) (with-db-critical-section db - (if (db-get-stamp spec) - (sqlite-exec db "UPDATE Stamps SET stamp=" stamp - "WHERE specification=" (assq-ref spec #:name) ";") - (sqlite-exec db "\ -INSERT INTO Stamps (specification, stamp) VALUES (" - (assq-ref spec #:name) ", " stamp ");")))) + (let loop ((rows (sqlite-exec + db "SELECT revision, input, directory FROM Checkouts +WHERE evaluation =" eval-id ";")) + (checkouts '())) + (match rows + (() checkouts) + ((#(revision input directory) + . rest) + (loop rest + (cons `((#:commit . ,revision) + (#:input . ,input) + (#:directory . ,directory)) + checkouts))))))) (define (db-get-evaluations limit) (with-db-critical-section db - (let loop ((rows (sqlite-exec db "SELECT id, specification, commits + (let loop ((rows (sqlite-exec db "SELECT id, specification, in_progress FROM Evaluations ORDER BY id DESC LIMIT " limit ";")) (evaluations '())) (match rows (() (reverse evaluations)) - ((#(id specification commits) + ((#(id specification in-progress) . rest) (loop rest (cons `((#:id . ,id) (#:specification . ,specification) - (#:commits . ,(string-tokenize commits))) + (#:in-progress . ,in-progress) + (#:checkouts . ,(db-get-checkouts id))) evaluations))))))) (define (db-get-evaluations-build-summary spec limit border-low border-high) (with-db-critical-section db (let loop ((rows (sqlite-exec db " -SELECT E.id, E.commits, B.succeeded, B.failed, B.scheduled +SELECT E.id, E.in_progress, B.succeeded, B.failed, B.scheduled FROM -(SELECT id, commits +(SELECT id, in_progress FROM Evaluations WHERE (specification=" spec ") AND (" border-low "IS NULL OR (id >" border-low ")) @@ -624,10 +663,12 @@ ORDER BY E.id ASC;")) (evaluations '())) (match rows (() evaluations) - ((#(id commits succeeded failed scheduled) . rest) + ((#(id in-progress succeeded failed scheduled) . rest) (loop rest (cons `((#:id . ,id) - (#:commits . ,commits) + (#:in-progress . ,in-progress) + (#:checkouts . ,(db-get-checkouts id)) + (#:in-progress . ,in-progress) (#:succeeded . ,(or succeeded 0)) (#:failed . ,(or failed 0)) (#:scheduled . ,(or scheduled 0))) diff --git a/src/cuirass/templates.scm b/src/cuirass/templates.scm index 6ba3a06..7ee579c 100644 --- a/src/cuirass/templates.scm +++ b/src/cuirass/templates.scm @@ -100,6 +100,27 @@ (href ,last-link)) "Last >>")))))) +(define (input-changes checkouts) + (let ((changes + (string-join + (map (lambda (checkout) + (let ((input (assq-ref checkout #:input)) + (commit (assq-ref checkout #:commit))) + (format #f "~a → ~a" input (substring commit 0 7)))) + checkouts) + ", "))) + (if (string=? changes "") '(em "None") changes))) + +(define (evaluation-badges evaluation) + (if (zero? (assq-ref evaluation #:in-progress)) + `((a (@ (href "#") (class "badge badge-success")) + ,(assq-ref evaluation #:succeeded)) + (a (@ (href "#") (class "badge badge-danger")) + ,(assq-ref evaluation #:failed)) + (a (@ (href "#") (class "badge badge-secondary")) + ,(assq-ref evaluation #:scheduled))) + '((em "In progress…")))) + (define (evaluation-info-table name evaluations id-min id-max) "Return HTML for the EVALUATION table NAME. ID-MIN and ID-MAX are global minimal and maximal id." @@ -111,7 +132,7 @@ `((thead (tr (th (@ (scope "col")) "#") - (th (@ (scope "col")) Commits) + (th (@ (scope "col")) "Input changes") (th (@ (scope "col")) Success))) (tbody ,@(map @@ -119,16 +140,8 @@ `(tr (th (@ (scope "row")) (a (@ (href "/eval/" ,(assq-ref row #:id))) ,(assq-ref row #:id))) - (td ,(string-join - (map (cut substring <> 0 7) - (string-tokenize (assq-ref row #:commits))) - ", ")) - (td (a (@ (href "#") (class "badge badge-success")) - ,(assq-ref row #:succeeded)) - (a (@ (href "#") (class "badge badge-danger")) - ,(assq-ref row #:failed)) - (a (@ (href "#") (class "badge badge-secondary")) - ,(assq-ref row #:scheduled))))) + (td ,(input-changes (assq-ref row #:checkouts))) + (td ,@(evaluation-badges row)))) evaluations))))) ,(if (null? evaluations) (pagination "" "" "" "") diff --git a/src/schema.sql b/src/schema.sql index 0452495..bfc9ca7 100644 --- a/src/schema.sql +++ b/src/schema.sql @@ -24,16 +24,22 @@ CREATE TABLE Inputs ( FOREIGN KEY (specification) REFERENCES Specifications (name) ); -CREATE TABLE Stamps ( - specification TEXT NOT NULL PRIMARY KEY, - stamp TEXT NOT NULL, - FOREIGN KEY (specification) REFERENCES Specifications (name) +CREATE TABLE Checkouts ( + specification TEXT NOT NULL, + revision TEXT NOT NULL, + evaluation INTEGER NOT NULL, + input TEXT NOT NULL, + directory TEXT NOT NULL, + PRIMARY KEY (specification, revision), + FOREIGN KEY (evaluation) REFERENCES Evaluations (id), + FOREIGN KEY (specification) REFERENCES Specifications (name), + FOREIGN KEY (input) REFERENCES Inputs (name) ); CREATE TABLE Evaluations ( id INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT, specification TEXT NOT NULL, - commits TEXT NOT NULL, + in_progress INTEGER NOT NULL, FOREIGN KEY (specification) REFERENCES Specifications (name) ); diff --git a/src/sql/upgrade-3.sql b/src/sql/upgrade-3.sql new file mode 100644 index 0000000..8e4a1bd --- /dev/null +++ b/src/sql/upgrade-3.sql @@ -0,0 +1,46 @@ +BEGIN TRANSACTION; + +ALTER TABLE Evaluations RENAME TO tmp_Evaluations; + +CREATE TABLE Evaluations ( + id INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT, + specification TEXT NOT NULL, + in_progress INTEGER NOT NULL, + FOREIGN KEY (specification) REFERENCES Specifications (name) +); + +CREATE TABLE Checkouts ( + specification TEXT NOT NULL, + revision TEXT NOT NULL, + evaluation INTEGER NOT NULL, + input TEXT NOT NULL, + directory TEXT NOT NULL, + PRIMARY KEY (specification, revision), + FOREIGN KEY (evaluation) REFERENCES Evaluations (id), + FOREIGN KEY (specification) REFERENCES Specifications (name), + FOREIGN KEY (input) REFERENCES Inputs (name) +); + +INSERT INTO Evaluations (id, specification, in_progress) +SELECT id, specification, false +FROM tmp_Evaluations; + +-- Copied from https://www.samuelbosch.com/2018/02/split-into-rows-sqlite.html. +INSERT OR IGNORE INTO Checkouts (specification, revision, evaluation, input, directory) +WITH RECURSIVE split(id, specification, revision, rest) AS ( + SELECT id, specification, '', commits || ' ' FROM tmp_Evaluations + UNION ALL + SELECT id, + specification, + substr(rest, 0, instr(rest, ' ')), + substr(rest, instr(rest, ' ') + 1) + FROM split + WHERE rest <> '') +SELECT specification, revision, id, 'unknown', 'unknown' + FROM split + WHERE revision <> ''; + +DROP TABLE tmp_Evaluations; +DROP TABLE Stamps; + +COMMIT; diff --git a/tests/database.scm b/tests/database.scm index cdc7872..21a12f4 100644 --- a/tests/database.scm +++ b/tests/database.scm @@ -47,9 +47,13 @@ (#:commit . #f) (#:no-compile? . #f)))))) -(define* (make-dummy-eval #:optional (commits '("cabba3e 61730ea"))) - `((#:specification . "guix") - (#:commits . ,commits))) +(define (make-dummy-checkouts fakesha1 fakesha2) + `(((#:commit . ,fakesha1) + (#:input . "guix") + (#:directory . "foo")) + ((#:commit . ,fakesha2) + (#:input . "packages") + (#:directory . "bar")))) (define* (make-dummy-build drv #:optional (eval-id 42) @@ -88,11 +92,11 @@ (test-assert "sqlite-exec" (begin (sqlite-exec (%db) "\ -INSERT INTO Evaluations (specification, commits) VALUES (1, 1);") +INSERT INTO Evaluations (specification, in_progress) VALUES (1, false);") (sqlite-exec (%db) "\ -INSERT INTO Evaluations (specification, commits) VALUES (2, 2);") +INSERT INTO Evaluations (specification, in_progress) VALUES (2, false);") (sqlite-exec (%db) "\ -INSERT INTO Evaluations (specification, commits) VALUES (3, 3);") +INSERT INTO Evaluations (specification, in_progress) VALUES (3, false);") (sqlite-exec (%db) "SELECT * FROM Evaluations;"))) (test-equal "db-add-specification" @@ -121,7 +125,8 @@ INSERT INTO Evaluations (specification, commits) VALUES (3, 3);") #:outputs '(("out" . "/foo"))))) (get-status (lambda* (#:optional (key #:status)) (assq-ref (db-get-build derivation) key)))) - (db-add-evaluation (make-dummy-eval)) + (db-add-evaluation "guix" (make-dummy-checkouts "fakesha1" + "fakesha2")) (db-add-specification example-spec) (let ((status0 (get-status))) @@ -157,9 +162,9 @@ INSERT INTO Evaluations (specification, commits) VALUES (3, 3);") #:outputs `(("out" . "/bar")))) (db-add-build (make-dummy-build "/baz.drv" 3 #:outputs `(("out" . "/baz")))) - (db-add-evaluation (make-dummy-eval)) - (db-add-evaluation (make-dummy-eval)) - (db-add-evaluation (make-dummy-eval)) + (db-add-evaluation "guix" (make-dummy-checkouts "fakesha1" "fakesha2")) + (db-add-evaluation "guix" (make-dummy-checkouts "fakesha1" "fakesha3")) + (db-add-evaluation "guix" (make-dummy-checkouts "fakssha2" "fakesha3")) (db-add-specification example-spec) (db-update-build-status! "/bar.drv" (build-status started) @@ -188,9 +193,9 @@ INSERT INTO Evaluations (specification, commits) VALUES (3, 3);") #:outputs `(("out" . "/bar")))) (db-add-build (make-dummy-build "/foo.drv" 3 #:outputs `(("out" . "/foo")))) - (db-add-evaluation (make-dummy-eval)) - (db-add-evaluation (make-dummy-eval)) - (db-add-evaluation (make-dummy-eval)) + (db-add-evaluation "guix" (make-dummy-checkouts "fakesha1" "fakesha2")) + (db-add-evaluation "guix" (make-dummy-checkouts "fakesha1" "fakesha3")) + (db-add-evaluation "guix" (make-dummy-checkouts "fakssha2" "fakesha3")) (db-add-specification example-spec) (sort (db-get-pending-derivations) string<?))) diff --git a/tests/http.scm b/tests/http.scm index 38e4175..ae56356 100644 --- a/tests/http.scm +++ b/tests/http.scm @@ -44,9 +44,12 @@ (hash-table-keys t2)) (hash-fold (lambda (key value result) (and result - (let ((equal? (if (hash-table? value) - hash-table=? - equal?))) + (let ((equal? + (match value + ((? hash-table?) hash-table=?) + (((? hash-table?) ...) + (cut every hash-table=? <> <>)) + (_ equal?)))) (equal? value (hash-ref t2 key))))) #t @@ -95,9 +98,12 @@ (#:buildinputs_builds . #nil))) (define evaluations-query-result - '((#:id . 2) - (#:specification . "guix") - (#:commits . ("fakesha2" "fakesha3")))) + '(((#:id . 2) + (#:specification . "guix") + (#:in-progress . 1) + (#:checkouts . (((#:commit . "fakesha2") + (#:input . "savannah") + (#:directory . "dir3"))))))) (test-group-with-cleanup "http" (test-assert "object->json-string" @@ -180,18 +186,33 @@ (#:branch . "master") (#:tag . #f) (#:commit . #f) + (#:no-compile? . #f)) + ((#:name . "packages") + (#:url . "git://git.savannah.gnu.org/guix.git") + (#:load-path . ".") + (#:branch . "master") + (#:tag . #f) + (#:commit . #f) (#:no-compile? . #f)))))) - (evaluation1 - '((#:specification . "guix") - (#:commits . ("fakesha1" "fakesha3")))) - (evaluation2 - '((#:specification . "guix") - (#:commits . ("fakesha2" "fakesha3"))))) + (checkouts1 + '(((#:commit . "fakesha1") + (#:input . "savannah") + (#:directory . "dir1")) + ((#:commit . "fakesha3") + (#:input . "packages") + (#:directory . "dir2")))) + (checkouts2 + '(((#:commit . "fakesha2") + (#:input . "savannah") + (#:directory . "dir3")) + ((#:commit . "fakesha3") + (#:input . "packages") + (#:directory . "dir4"))))) (db-add-build build1) (db-add-build build2) (db-add-specification specification) - (db-add-evaluation evaluation1) - (db-add-evaluation evaluation2))) + (db-add-evaluation "guix" checkouts1) + (db-add-evaluation "guix" checkouts2))) (test-assert "/build/1" (hash-table=? @@ -271,9 +292,9 @@ (and (= (length hash-list) 1) (hash-table=? (car hash-list) - (call-with-input-string - (object->json-string evaluations-query-result) - json->scm))))) + (car (call-with-input-string + (object->json-string evaluations-query-result) + json->scm)))))) (test-assert "db-close" (db-close (%db))) |