summaryrefslogtreecommitdiff
path: root/examples
diff options
context:
space:
mode:
authorClément Lassieur <clement@lassieur.org>2018-06-26 11:18:23 +0200
committerClément Lassieur <clement@lassieur.org>2018-07-16 21:33:14 +0200
commit7b2f9e0de1ad2d320973b7aea132a8afcad8bece (patch)
tree6143d4bf334b645001ebde583247125123a8c853 /examples
parentbe713f8a30788861806a74865b07403aa6774117 (diff)
downloadcuirass-7b2f9e0de1ad2d320973b7aea132a8afcad8bece.tar
cuirass-7b2f9e0de1ad2d320973b7aea132a8afcad8bece.tar.gz
Add support for multiple inputs.
* Makefile.am (dist_sql_DATA): Add src/sql/upgrade-1.sql. * bin/cuirass.in (show-help, %options, main): Remove the LOAD-PATH option that was used afterwards as %GUIX-PACKAGE-PATH. * bin/evaluate.in (absolutize, input-checkout, spec-source, spec-load-path, spec-package-path, format-checkouts): New procedures. (%not-colon): Remove variable. (main): Take the load path, package path and PROC from the checkouts that result from the inputs. Format the checkouts before sending them to the procedure. Remove the LOAD-PATH argument. * doc/cuirass.texi (Overview, Database schema): Document the changes. * examples/{guix-jobs.scm, hello-git.scm, hello-singleton.scm, hello-subset.scm, random.scm}: Adapt to the new specification format. * examples/guix-track-git.scm (package->spec): Rename to PACKAGE->INPUT. (package->git-tracked): Replace FETCH-REPOSITORY with FETCH-INPUT and handle the new format of its return value. * examples/random-jobs.scm (make-random-jobs): Rename RANDOM to CHECKOUT. Rename the checkout from 'random (which is a specification) to 'cuirass (which is a checkout resulting from an input). * src/cuirass/base.scm (fetch-repository): Rename to fetch-input. Rename SPEC to INPUT. Return a checkout object instead of returning two values. (evaluate): Take a list of CHECKOUTS and COMMITS as arguments, instead of SOURCE. Remove TOKENIZE and LOAD-PATH. Pass the CHECKOUTS instead of the SOURCE to "evaluate". Remove %GUIX-PACKAGE-PATH. Build the EVAL object instead of getting it from "evaluate". (compile?, fetch-inputs, compile-checkouts): New procedures. (process-specs): Fetch all inputs instead of only fetching one repository. The result of that fetching operation is a list of CHECKOUTS whose COMMITS are used as a STAMP. (%guix-package-path, set-guix-package-path): Remove them. * src/cuirass/database.scm (db-add-input, db-get-inputs): New procedures. (db-add-specification, db-get-specifications): Adapt to the new specification format. Add/get all inputs as well. (db-add-evaluation): Rename REVISION to COMMITS. Store COMMITS as space separated commit hashes. (db-get-builds): Rename REPO_NAME to NAME. (db-get-stamp): Rename COMMIT to STAMP. Return #f when there is no STAMP. (db-add-stamp): Rename COMMIT to STAMP. Deal with DB-GET-STAMP's new return value. (db-get-evaluations): Rename REVISION to COMMITS. Tokenize COMMITS. * src/cuirass/utils.scm (%non-blocking): Export it. * src/schema.sql (Inputs): New table that refers to the Specifications table. (Specifications): Move input related fields to the Inputs table. Rename REPO_NAME to NAME. Rename ARGUMENTS to PROC_ARGS. Rename FILE to PROC_FILE. Add LOAD_PATH_INPUTS, PACKAGE_PATH_INPUTS and PROC_INPUT fields that refer to the Inputs table. (Stamps): Rename REPO_NAME to NAME. (Evaluations): Rename REPO_NAME to NAME. Rename REVISION to COMMITS. (Specifications_index): Replace with Inputs_index. * src/sql/upgrade-1.sql: New file. * tests/database.scm (example-spec, make-dummy-eval, sqlite-exec): Adapt to the new specifications format. Rename REVISION to COMMITS. * tests/http.scm (evaluations-query-result, fill-db): Idem.
Diffstat (limited to 'examples')
-rw-r--r--examples/guix-jobs.scm38
-rw-r--r--examples/guix-track-git.scm26
-rw-r--r--examples/hello-git.scm55
-rw-r--r--examples/hello-singleton.scm28
-rw-r--r--examples/hello-subset.scm39
-rw-r--r--examples/random-jobs.scm7
-rw-r--r--examples/random.scm17
7 files changed, 116 insertions, 94 deletions
diff --git a/examples/guix-jobs.scm b/examples/guix-jobs.scm
index 862cff7..963c7ff 100644
--- a/examples/guix-jobs.scm
+++ b/examples/guix-jobs.scm
@@ -1,5 +1,6 @@
;;; guix-jobs.scm -- job specification test for Guix
;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
+;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;;
;;; This file is part of Cuirass.
;;;
@@ -16,22 +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/>.
-(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))
-
-(define job-base
- `((#:name . "guix")
- (#:url . "git://git.savannah.gnu.org/guix.git")
- (#:load-path . ".")
- (#:file . ,(local-file "gnu-system.scm"))
- (#:proc . hydra-jobs)))
+(define (job-base key value)
+ `((#:name . ,(string-append "guix-" value))
+ (#:load-path-inputs . ("guix"))
+ (#:package-path-inputs . ())
+ (#:proc-input . "cuirass")
+ (#:proc-file . "examples/gnu-system.scm")
+ (#:proc . hydra-jobs)
+ (#:proc-args (subset . "hello"))
+ (#:inputs . (,(acons key value
+ '((#:name . "guix")
+ (#:url . "git://git.savannah.gnu.org/guix.git")
+ (#:load-path . ".")
+ (#:no-compile? . #t)))
+ ((#:name . "cuirass")
+ (#:url . "https://git.savannah.gnu.org/git/guix/guix-cuirass.git")
+ (#:load-path . ".")
+ (#:branch . "master")
+ (#:no-compile? . #t))))))
(define guix-master
- (acons #:branch "master" job-base))
+ (job-base #:branch "master"))
-(define guix-0.10
- (acons #:tag "v0.10.0" job-base))
+(define guix-0.15
+ (job-base #:tag "v0.15.0"))
-(list guix-master guix-0.10)
+(list guix-master guix-0.15)
diff --git a/examples/guix-track-git.scm b/examples/guix-track-git.scm
index 2a538fa..ab8abaa 100644
--- a/examples/guix-track-git.scm
+++ b/examples/guix-track-git.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;;
;;; This file is part of Cuirass.
;;;
@@ -154,7 +155,7 @@ valid."
(string-map (lambda (c) (if (memq c (string->list ":/")) #\- c)) url)
#\-))
-(define* (package->spec pkg #:key (branch "master") commit url)
+(define* (package->input pkg #:key (branch "master") commit url)
(let ((url (or url ((compose git-reference-url origin-uri package-source) pkg))))
`((#:name . ,(url->file-name url))
(#:url . ,url)
@@ -195,17 +196,18 @@ valid."
(uri (origin-uri source)))
(if (not branch)
pkg
- (let* ((spec (package->spec pkg #:branch branch #:commit commit #:url url)))
- (let-values (((checkout commit)
- (fetch-repository store spec)))
- (let* ((url (or url (git-reference-url uri)))
- ; maybe (string-append (%package-cachedir) "/" (url->file-name url))
- (git-dir checkout)
- (hash (bytevector->nix-base32-string (file-hash git-dir)))
- (source (origin (uri (git-reference (url url) (commit commit)))
- (method git-fetch)
- (sha256 (base32 hash)))))
- (set-fields pkg ((package-source) source))))))))
+ (let* ((input (package->input pkg #:branch branch #:commit commit #:url url))
+ (checkout (fetch-input store input))
+ (url (or url (git-reference-url uri)))
+ ;; maybe (string-append (%package-cachedir) "/" (url->file-name url))
+ (git-dir (assq-ref checkout #:directory))
+ (hash (bytevector->nix-base32-string (file-hash git-dir)))
+ (source (origin (uri (git-reference
+ (url url)
+ (commit (assq-ref checkout #:commit))))
+ (method git-fetch)
+ (sha256 (base32 hash)))))
+ (set-fields pkg ((package-source) source))))))
;;;
diff --git a/examples/hello-git.scm b/examples/hello-git.scm
index f6df99c..6468452 100644
--- a/examples/hello-git.scm
+++ b/examples/hello-git.scm
@@ -1,6 +1,7 @@
;;; hello-git.scm -- job specification test for hello git repository
;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;;
;;; This file is part of Cuirass.
;;;
@@ -17,37 +18,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 (srfi srfi-1))
-
-(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))
-
-(define (url->file-name url)
- (string-trim
- (string-map (lambda (c) (if (memq c (string->list ":/")) #\- c)) url)
- #\-))
-
-(define vc
- ;; where your version-control checkouts live
- (string-append (getenv "HOME") "/src"))
-(define guix-checkout (string-append vc "/guix"))
-
;; building GNU hello from git is too much work
-;; (define hello-checkout (string-append vc "/hello"))
-;; (define hello-git "http://git.savannah.gnu.org/r/hello.git")
+(define cuirass-git "https://git.savannah.gnu.org/git/guix/guix-cuirass.git")
;; ... so let's track cuirass' git
-(define cuirass-checkout (string-append vc "/cuirass"))
-(define cuirass-git "https://notabug.org/mthl/cuirass")
-;;(define cuirass-git "https://gitlab.com/janneke/cuirass.git")
-(list
- `((#:name . ,(url->file-name cuirass-checkout))
- (#:url . ,cuirass-git)
- (#:branch . "master")
- (#:no-compile? . #t)
- (#:load-path . ,guix-checkout)
- (#:proc . guix-jobs)
- (#:file . ,(local-file "guix-track-git.scm"))
- (#:arguments (name . "cuirass") (url . ,cuirass-git))))
+;; This builds the Guix Cuirass package with its source replaced by the last
+;; commit of Cuirass' git repository.
+(let ((top-srcdir (canonicalize-path
+ (string-append (dirname (current-filename)) "/.."))))
+ (list
+ `((#:name . "cuirass")
+ (#:load-path-inputs . ("guix"))
+ (#:package-path-inputs . ())
+ (#:proc-input . "cuirass")
+ (#:proc-file . "examples/guix-track-git.scm")
+ (#:proc . guix-jobs)
+ (#:proc-args (name . "cuirass") (url . ,cuirass-git))
+ (#:inputs . (((#:name . "guix")
+ (#:url . "git://git.savannah.gnu.org/guix.git")
+ (#:load-path . ".")
+ (#:branch . "master")
+ (#:no-compile? . #t))
+ ((#:name . "cuirass")
+ (#:url . ,(string-append "file://" top-srcdir))
+ (#:load-path . ".")
+ (#:branch . "master")
+ (#:no-compile? . #t)))))))
diff --git a/examples/hello-singleton.scm b/examples/hello-singleton.scm
index 5ff2e82..a39191f 100644
--- a/examples/hello-singleton.scm
+++ b/examples/hello-singleton.scm
@@ -1,5 +1,6 @@
;;; hello-singleton.scm -- job specification test for hello in master
;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
+;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;;
;;; This file is part of Cuirass.
;;;
@@ -16,18 +17,23 @@
;;; You should have received a copy of the GNU General Public License
;;; along with Cuirass. If not, see <http://www.gnu.org/licenses/>.
-(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))
-
(define hello-master
- `((#:name . "guix")
- (#:url . "git://git.savannah.gnu.org/guix.git")
- (#:load-path . ".")
- (#:file . ,(local-file "gnu-system.scm"))
+ '((#:name . "guix-master")
+ (#:load-path-inputs . ("guix"))
+ (#:package-path-inputs . ())
+ (#:proc-input . "cuirass")
+ (#:proc-file . "examples/gnu-system.scm")
(#:proc . hydra-jobs)
- (#:arguments (subset . "hello"))
- (#:branch . "master")))
+ (#:proc-args (subset . "hello"))
+ (#:inputs . (((#:name . "guix")
+ (#:url . "git://git.savannah.gnu.org/guix.git")
+ (#:load-path . ".")
+ (#:branch . "master")
+ (#:no-compile? . #t))
+ ((#:name . "cuirass")
+ (#:url . "https://git.savannah.gnu.org/git/guix/guix-cuirass.git")
+ (#:load-path . ".")
+ (#:branch . "master")
+ (#:no-compile? . #t))))))
(list hello-master)
diff --git a/examples/hello-subset.scm b/examples/hello-subset.scm
index 60764fc..8c0d990 100644
--- a/examples/hello-subset.scm
+++ b/examples/hello-subset.scm
@@ -1,5 +1,6 @@
;;; hello-subset.scm -- job specification test for hello subset
;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
+;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;;
;;; This file is part of Cuirass.
;;;
@@ -16,28 +17,34 @@
;;; You should have received a copy of the GNU General Public License
;;; along with Cuirass. If not, see <http://www.gnu.org/licenses/>.
-(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))
-
-(define job-base
- `((#:name . "guix")
- (#:url . "git://git.savannah.gnu.org/guix.git")
- (#:load-path . ".")
- (#:file . ,(local-file "gnu-system.scm"))
+(define (job-base key value)
+ `((#:name . ,(string-append "guix-" value))
+ (#:load-path-inputs . ("guix"))
+ (#:package-path-inputs . ())
+ (#:proc-input . "cuirass")
+ (#:proc-file . "examples/gnu-system.scm")
(#:proc . hydra-jobs)
- (#:arguments (subset . "hello"))))
+ (#:proc-args (subset . "hello"))
+ (#:inputs . (,(acons key value
+ '((#:name . "guix")
+ (#:url . "git://git.savannah.gnu.org/guix.git")
+ (#:load-path . ".")
+ (#:no-compile? . #t)))
+ ((#:name . "cuirass")
+ (#:url . "https://git.savannah.gnu.org/git/guix/guix-cuirass.git")
+ (#:load-path . ".")
+ (#:branch . "master")
+ (#:no-compile? . #t))))))
(define guix-master
- (acons #:branch "master" job-base))
+ (job-base #:branch "master"))
(define guix-core-updates
- (acons #:branch "core-updates" job-base))
+ (job-base #:branch "core-updates"))
-(define guix-0.10
- (acons #:tag "v0.10.0" job-base))
+(define guix-0.15
+ (job-base #:tag "v0.15.0"))
(list guix-master
guix-core-updates
- guix-0.10)
+ guix-0.15)
diff --git a/examples/random-jobs.scm b/examples/random-jobs.scm
index 78a09f4..6521734 100644
--- a/examples/random-jobs.scm
+++ b/examples/random-jobs.scm
@@ -1,5 +1,6 @@
;;; random.scm -- Definition of the random build jobs
;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;;
;;; This file is part of Cuirass.
;;;
@@ -42,11 +43,11 @@
(mkdir #$output))))))
(define (make-random-jobs store arguments)
- (let ((random (assq-ref arguments 'random)))
+ (let ((checkout (assq-ref arguments 'cuirass)))
(format (current-error-port)
"evaluating random jobs from directory ~s, commit ~s~%"
- (assq-ref random 'file-name)
- (assq-ref random 'revision)))
+ (assq-ref checkout 'file-name)
+ (assq-ref checkout 'revision)))
(unfold (cut > <> 10)
(lambda (i)
diff --git a/examples/random.scm b/examples/random.scm
index 820ac8d..37b97a2 100644
--- a/examples/random.scm
+++ b/examples/random.scm
@@ -1,5 +1,6 @@
;;; random.scm -- Job specification that creates random build jobs
;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;;
;;; This file is part of Cuirass.
;;;
@@ -20,10 +21,14 @@
(string-append (dirname (current-filename)) "/.."))))
(list
`((#:name . "random")
- (#:url . ,(string-append "file://" top-srcdir))
- (#:branch . "master")
- (#:no-compile? . #t)
- (#:load-path . ".")
+ (#:load-path-inputs . ()) ;use the Guix shipped with Cuirass
+ (#:package-path-inputs . ())
+ (#:proc-input . "cuirass")
+ (#:proc-file . "examples/random-jobs.scm")
(#:proc . make-random-jobs)
- (#:file . "examples/random-jobs.scm")
- (#:arguments . ()))))
+ (#:proc-args . ())
+ (#:inputs . (((#:name . "cuirass")
+ (#:url . ,(string-append "file://" top-srcdir))
+ (#:load-path . ".")
+ (#:branch . "master")
+ (#:no-compile? . #t)))))))