database.scm 2.5 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485
  1. ;;;; database.scm - tests for (cuirass database) module
  2. ;;;
  3. ;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
  4. ;;;
  5. ;;; This file is part of Cuirass.
  6. ;;;
  7. ;;; Cuirass is free software; you can redistribute it and/or modify it
  8. ;;; under the terms of the GNU General Public License as published by
  9. ;;; the Free Software Foundation; either version 3 of the License, or (at
  10. ;;; your option) any later version.
  11. ;;;
  12. ;;; Cuirass is distributed in the hope that it will be useful, but
  13. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15. ;;; GNU General Public License for more details.
  16. ;;;
  17. ;;; You should have received a copy of the GNU General Public License
  18. ;;; along with Cuirass. If not, see <http://www.gnu.org/licenses/>.
  19. (use-modules (cuirass database)
  20. (srfi srfi-64))
  21. (define example-spec
  22. '((#:name . "guix")
  23. (#:url . "git://git.savannah.gnu.org/guix.git")
  24. (#:load-path . ".")
  25. (#:file . "/tmp/gnu-system.scm")
  26. (#:proc . hydra-jobs)
  27. (#:arguments (subset . "hello"))
  28. (#:branch . "master")
  29. (#:tag . #f)
  30. (#:commit . #f)
  31. (#:no-compile? . #f)))
  32. (define* (make-dummy-job #:optional (name "foo"))
  33. `((#:name . ,name)
  34. (#:derivation . ,(string-append name ".drv"))
  35. (#:specification 0)))
  36. (define %db
  37. ;; Global Slot for a database object.
  38. (make-parameter #t))
  39. (define %id
  40. ;; Global Slot for a job ID in the database.
  41. (make-parameter #t))
  42. (define database-name
  43. ;; Use an empty and temporary database for the tests.
  44. (string-append (getcwd) "/" (number->string (getpid)) "-tmp.db"))
  45. (test-group-with-cleanup "database"
  46. (test-assert "db-init"
  47. (%db (db-init database-name)))
  48. (test-assert "sqlite-exec"
  49. (begin
  50. (sqlite-exec (%db) "\
  51. INSERT INTO Evaluations (specification, revision) VALUES (1, 1);")
  52. (sqlite-exec (%db) "\
  53. INSERT INTO Evaluations (specification, revision) VALUES (2, 2);")
  54. (sqlite-exec (%db) "\
  55. INSERT INTO Evaluations (specification, revision) VALUES (3, 3);")
  56. (sqlite-exec (%db) "SELECT * FROM Evaluations;")))
  57. (test-equal "db-add-specification"
  58. example-spec
  59. (begin
  60. (db-add-specification (%db) example-spec)
  61. (car (db-get-specifications (%db)))))
  62. (test-assert "db-add-derivation"
  63. (let* ((job (make-dummy-job))
  64. (key (assq-ref job #:derivation)))
  65. (db-add-derivation (%db) job)
  66. (%id key)))
  67. (test-assert "db-get-derivation"
  68. (db-get-derivation (%db) (%id)))
  69. (test-assert "db-close"
  70. (db-close (%db)))
  71. (delete-file database-name))