diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/database.scm | 13 | ||||
| -rw-r--r-- | tests/gnu-system.scm | 88 | ||||
| -rw-r--r-- | tests/guix-jobs.scm | 32 | ||||
| -rw-r--r-- | tests/hello-subset.scm | 51 |
4 files changed, 87 insertions, 97 deletions
diff --git a/tests/database.scm b/tests/database.scm index 232eab4..869d73c 100644 --- a/tests/database.scm +++ b/tests/database.scm @@ -21,10 +21,9 @@ (cuirass job) (srfi srfi-64)) -(define* (make-dummy-job #:optional (name "foo") #:key (metadata '())) - (make-job #:name name - #:derivation (string-append name ".drv") - #:metadata metadata)) +(define* (make-dummy-job #:optional (name "foo")) + `((#:name . ,name) + (#:derivation . ,(string-append name ".drv")))) (define %db ;; Global Slot for a database object. @@ -51,11 +50,11 @@ (db-get-evaluation (%db) (%id))) (test-equal "db-add-build-log" - (let ((job (make-dummy-job #:metadata `((id . ,(%id))))) + "foo log" + (let ((job (acons #:id (%id) (make-dummy-job))) (log-column 3)) (db-add-build-log (%db) job "foo log") - (vector-ref (db-get-evaluation (%db) (%id)) log-column)) - "foo log") + (vector-ref (db-get-evaluation (%db) (%id)) log-column))) (test-assert "db-close" (db-close (%db)))) diff --git a/tests/gnu-system.scm b/tests/gnu-system.scm index 520c33d..fc7c15f 100644 --- a/tests/gnu-system.scm +++ b/tests/gnu-system.scm @@ -25,8 +25,7 @@ ;; newer, even though they may not correspond. (set! %fresh-auto-compile #t)) -(use-modules (cuirass job) - (guix config) +(use-modules (guix config) (guix store) (guix grafts) (guix packages) @@ -55,36 +54,38 @@ (define (package-metadata package) "Convert PACKAGE to an alist suitable for Hydra." - `((description . ,(package-synopsis package)) - (long-description . ,(package-description package)) - (license . ,(package-license package)) - (home-page . ,(package-home-page package)) - (maintainers . ("bug-guix@gnu.org")) - (max-silent-time . ,(or (assoc-ref (package-properties package) - 'max-silent-time) - 3600)) ;1 hour by default - (timeout . ,(or (assoc-ref (package-properties package) 'timeout) - 72000)))) ;20 hours by default + `((#:description . ,(package-synopsis package)) + (#:long-description . ,(package-description package)) + ;; (#:license . ,(package-license package)) + (#:home-page . ,(package-home-page package)) + (#:maintainers . ("bug-guix@gnu.org")) + (#:max-silent-time . ,(or (assoc-ref (package-properties package) + 'max-silent-time) + 3600)) ;1 hour by default + (#:timeout . ,(or (assoc-ref (package-properties package) 'timeout) + 72000)))) ;20 hours by default (define (package-job store job-name package system) "Return a job called JOB-NAME that builds PACKAGE on SYSTEM." - (make-job - #:name (string-append (symbol->string job-name) "." system) - #:derivation (derivation-file-name - (parameterize ((%graft? #f)) - (package-derivation store package system #:graft? #f))) - #:metadata (package-metadata package))) + (λ () + `((#:job-name . ,(string-append (symbol->string job-name) "." system)) + (#:derivation . ,(derivation-file-name + (parameterize ((%graft? #f)) + (package-derivation store package system + #:graft? #f)))) + ,@(package-metadata package)))) (define (package-cross-job store job-name package target system) "Return a job called TARGET.JOB-NAME that cross-builds PACKAGE for TARGET on SYSTEM." - (make-job - #:name (string-append target "." (symbol->string job-name) "." system) - #:derivation (derivation-file-name - (parameterize ((%graft? #f)) - (package-cross-derivation store package target system - #:graft? #f))) - #:metadata (package-metadata package))) + (λ () + `((#:job-name . ,(string-join (list target (symbol->string job-name) system) + ".")) + (#:derivation . ,(derivation-file-name + (parameterize ((%graft? #f)) + (package-cross-derivation store package target system + #:graft? #f)))) + ,@(package-metadata package)))) (define %core-packages ;; Note: Don't put the '-final' package variants because (1) that's @@ -107,25 +108,24 @@ for TARGET on SYSTEM." '("mips64el-linux-gnu" "mips64el-linux-gnuabi64")) -(define (tarball-jobs store system) +(define (tarball-job store system) "Return Hydra jobs to build the self-contained Guix binary tarball." - (list - (make-job - #:name (string-append "binary-tarball." system) - #:derivation (derivation-file-name - (parameterize ((%graft? #f)) - (run-with-store store - (mbegin %store-monad - (set-guile-for-build (default-guile)) - (self-contained-tarball)) - #:system system))) - #:metadata - `((description . "Stand-alone binary Guix tarball") - (long-description . "This is a tarball containing binaries of Guix and -all its dependencies, and ready to be installed on non-GuixSD distributions.") - (license . ,gpl3+) - (home-page . ,%guix-home-page-url) - (maintainers . ("bug-guix@gnu.org")))))) + (λ () + `((#:job-name . (string-append "binary-tarball." system)) + (#:derivation . ,(derivation-file-name + (parameterize ((%graft? #f)) + (run-with-store store + (mbegin %store-monad + (set-guile-for-build (default-guile)) + (self-contained-tarball)) + #:system system)))) + (#:description . "Stand-alone binary Guix tarball") + (#:long-description . "This is a tarball containing binaries of Guix +and all its dependencies, and ready to be installed on non-GuixSD +distributions.") + ;; (#:license . ,gpl3+) + (#:home-page . ,%guix-home-page-url) + (#:maintainers . ("bug-guix@gnu.org"))))) (define %job-name ;; Return the name of a package's job. @@ -207,7 +207,7 @@ valid." (append (filter-map (lambda (pkg) (package->job store pkg system)) pkgs) - (tarball-jobs store system) + (list (tarball-job store system)) (cross-jobs system)))) ((core) ;; Build core packages only. diff --git a/tests/guix-jobs.scm b/tests/guix-jobs.scm index 9196147..470305f 100644 --- a/tests/guix-jobs.scm +++ b/tests/guix-jobs.scm @@ -17,24 +17,20 @@ ;;; You should have received a copy of the GNU General Public License ;;; along with Cuirass. If not, see <http://www.gnu.org/licenses/>. -(use-modules (cuirass job)) - -;; In the common case jobs will be defined relative to the repository. -;; However for testing purpose use local gnu-system.scm instead. (define (local-file file) + ;; In the common case jobs will be defined relative to the repository. + ;; However for testing purpose use local gnu-system.scm instead. (string-append (dirname (current-filename)) "/" file)) -(list (make-job-spec - #:name "guix" - #:url "git://git.savannah.gnu.org/guix.git" - #:load-path "." - #:branch "master" - #:file (local-file "gnu-system.scm") - #:proc 'hydra-jobs) - (make-job-spec - #:name "guix" - #:url "git://git.savannah.gnu.org/guix.git" - #:load-path "." - #:tag "v0.10.0" - #:file (local-file "gnu-system.scm") - #:proc 'hydra-jobs)) +`(((#:name . "guix") + (#:url . "git://git.savannah.gnu.org/guix.git") + (#:load-path . ".") + (#:branch . "master") + (#:file . ,(local-file "gnu-system.scm")) + (#:proc . hydra-jobs)) + ((#:name . "guix") + (#:url . "git://git.savannah.gnu.org/guix.git") + (#:load-path . ".") + (#:tag . "v0.10.0") + (#:file . ,(local-file "gnu-system.scm")) + (#:proc . hydra-jobs))) diff --git a/tests/hello-subset.scm b/tests/hello-subset.scm index f904782..76136ef 100644 --- a/tests/hello-subset.scm +++ b/tests/hello-subset.scm @@ -17,34 +17,29 @@ ;;; You should have received a copy of the GNU General Public License ;;; along with Cuirass. If not, see <http://www.gnu.org/licenses/>. -(use-modules (cuirass job)) - -;; In the common case jobs will be defined relative to the repository. -;; However for testing purpose use local gnu-system.scm instead. (define (local-file file) + ;; In the common case jobs will be defined relative to the repository. + ;; However for testing purpose use local gnu-system.scm instead. (string-append (dirname (current-filename)) "/" file)) -(list (make-job-spec - #:name "guix" - #:url "git://git.savannah.gnu.org/guix.git" - #:load-path "." - #:branch "master" - #:file (local-file "gnu-system.scm") - #:proc 'hydra-jobs - #:arguments '((subset . "hello"))) - (make-job-spec - #:name "guix" - #:url "git://git.savannah.gnu.org/guix.git" - #:load-path "." - #:branch "core-updates" - #:file (local-file "gnu-system.scm") - #:proc 'hydra-jobs - #:arguments '((subset . "hello"))) - (make-job-spec - #:name "guix" - #:url "git://git.savannah.gnu.org/guix.git" - #:load-path "." - #:tag "v0.9.0" - #:file (local-file "gnu-system.scm") - #:proc 'hydra-jobs - #:arguments '((subset . "hello")))) +`(((#:name . "guix") + (#:url . "git://git.savannah.gnu.org/guix.git") + (#:load-path . ".") + (#:branch . "master") + (#:file . ,(local-file "gnu-system.scm")) + (#:proc . hydra-jobs) + (#:arguments (subset . "hello"))) + ((#:name . "guix") + (#:url . "git://git.savannah.gnu.org/guix.git") + (#:load-path . ".") + (#:branch . "core-updates") + (#:file . ,(local-file "gnu-system.scm")) + (#:proc . hydra-jobs) + (#:arguments (subset . "hello"))) + ((#:name . "guix") + (#:url . "git://git.savannah.gnu.org/guix.git") + (#:load-path . ".") + (#:tag . "v0.9.0") + (#:file . ,(local-file "gnu-system.scm")) + (#:proc . hydra-jobs) + (#:arguments (subset . "hello")))) |