diff options
| -rw-r--r-- | src/cuirass/database.scm | 26 | ||||
| -rw-r--r-- | tests/database.scm | 1 |
2 files changed, 20 insertions, 7 deletions
diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm index d3e2666..dd3e5a2 100644 --- a/src/cuirass/database.scm +++ b/src/cuirass/database.scm @@ -216,15 +216,25 @@ INSERT OR IGNORE INTO Specifications (repo_name, url, load_path, file, \ (define (db-add-derivation db job) "Store a derivation result in database DB and return its ID." - (sqlite-exec db "\ + (catch 'sqlite-error + (lambda () + (sqlite-exec db "\ INSERT INTO Derivations (derivation, job_name, system, nix_name, evaluation)\ VALUES (" - (assq-ref job #:derivation) ", " - (assq-ref job #:job-name) ", " - (assq-ref job #:system) ", " - (assq-ref job #:nix-name) ", " - (assq-ref job #:eval-id) ");") - (last-insert-rowid db)) + (assq-ref job #:derivation) ", " + (assq-ref job #:job-name) ", " + (assq-ref job #:system) ", " + (assq-ref job #:nix-name) ", " + (assq-ref job #:eval-id) ");") + (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 (derivation,eval-id) tuple. That happens + ;; when several jobs produce the same derivation, and we can ignore it. + (if (= code SQLITE_CONSTRAINT_PRIMARYKEY) + (sqlite-exec db "SELECT * FROM Derivations WHERE derivation=" + (assq-ref job #:derivation) ";") + (apply throw key who code rest))))) (define (db-get-derivation db id) "Retrieve a job in database DB which corresponds to ID." @@ -261,6 +271,8 @@ string." (define SQLITE_CONSTRAINT 19) (define SQLITE_CONSTRAINT_PRIMARYKEY (logior SQLITE_CONSTRAINT (ash 6 8))) +(define SQLITE_CONSTRAINT_UNIQUE + (logior SQLITE_CONSTRAINT (ash 8 8))) (define-enumeration build-status ;; Build status as expected by Hydra's API. Note: the negative values are diff --git a/tests/database.scm b/tests/database.scm index 306068b..902c94e 100644 --- a/tests/database.scm +++ b/tests/database.scm @@ -106,6 +106,7 @@ INSERT INTO Evaluations (specification, revision) VALUES (3, 3);") (let* ((job (make-dummy-job)) (key (assq-ref job #:derivation))) (db-add-derivation (%db) job) + (db-add-derivation (%db) job) ;idempotent (%id key))) (test-assert "db-get-derivation" |