diff options
| -rw-r--r-- | Makefile.am | 2 | ||||
| -rw-r--r-- | build-aux/guix.scm | 6 | ||||
| -rw-r--r-- | src/cuirass/repo.scm | 80 | ||||
| -rw-r--r-- | tests/repo.scm | 81 |
4 files changed, 0 insertions, 169 deletions
diff --git a/Makefile.am b/Makefile.am index ee911af..0fff919 100644 --- a/Makefile.am +++ b/Makefile.am @@ -34,7 +34,6 @@ dist_pkgmodule_DATA = \ src/cuirass/base.scm \ src/cuirass/database.scm \ src/cuirass/http.scm \ - src/cuirass/repo.scm \ src/cuirass/ui.scm \ src/cuirass/utils.scm @@ -65,7 +64,6 @@ TESTS = \ ## tests/basic.sh # takes too long to execute tests/database.scm \ tests/http.scm \ - tests/repo.scm \ tests/ui.scm \ tests/utils.scm diff --git a/build-aux/guix.scm b/build-aux/guix.scm index d816713..57ba8ab 100644 --- a/build-aux/guix.scm +++ b/build-aux/guix.scm @@ -60,12 +60,6 @@ (arguments '(#:phases (modify-phases %standard-phases - (add-after 'unpack 'disable-repo-tests - ;; Disable tests that use a connection to the Guix daemon. - (λ _ - (substitute* "Makefile.am" - (("tests/repo.scm \\\\") "\\")) - #t)) (add-before 'configure 'bootstrap (λ _ (zero? (system* "sh" "bootstrap")))) (add-after 'install 'wrap-program diff --git a/src/cuirass/repo.scm b/src/cuirass/repo.scm deleted file mode 100644 index 26ea328..0000000 --- a/src/cuirass/repo.scm +++ /dev/null @@ -1,80 +0,0 @@ -;;;; repo.scm -- manage code repositories -;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org> -;;; -;;; This file is part of Cuirass. -;;; -;;; Cuirass is free software: you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation, either version 3 of the License, or -;;; (at your option) any later version. -;;; -;;; Cuirass is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with Cuirass. If not, see <http://www.gnu.org/licenses/>. - -(define-module (cuirass repo) - #:use-module (cuirass utils) - #:use-module (guix store) - #:use-module (srfi srfi-9 gnu) - #:export (repo - repo? - repo-id - repo-url - repo-location - repo-reference - repo-snapshoter - repo-snapshot - repo-updater - repo-update - file-repo)) - -(define-immutable-record-type <repo> - ;; An Abstract repository. Use "repo" as a shortname for "repository". - (make-repo id url location ref snapshoter updater) - repo? - (id repo-id) ;string - (url repo-url) ;string - (location repo-location) ;string - (ref repo-reference) ;string - (snapshoter repo-snapshoter) ;method - (updater repo-updater)) ;method - -(define* (repo #:key id url location ref snapshoter updater) - ;; Convenient <repo> constructor using keyword arguments. - (make-repo id url location ref snapshoter updater)) - -(define (repo-snapshot repo store) - "Send a snapshot of REPO to the STORE." - ((repo-snapshoter repo) repo store)) - -(define* (repo-update repo #:optional ref) - "Pull changes from REPO according to reference REF." - ((repo-updater repo) repo ref)) - -;;; -;;; Concrete repositories. -;;; - -(define file-repo - (let ((hash-algo "sha256")) - (define (file-repo-snapshot this store) - ;; Send file to the STORE. - (let* ((basename (repo-id this)) - (file (repo-location this)) - (directory? (eq? 'directory (stat:type (stat file))))) - (add-to-store store basename directory? hash-algo file))) - - (define (file-repo-update this ref) - ;; Ensure that file still exists. - (stat (repo-location this))) - - (λ* (file-name #:key id) - "Basic repository that handles a local file or directory." - (repo #:id (or id file-name) - #:location file-name - #:snapshoter file-repo-snapshot - #:updater file-repo-update)))) diff --git a/tests/repo.scm b/tests/repo.scm deleted file mode 100644 index 8890c0a..0000000 --- a/tests/repo.scm +++ /dev/null @@ -1,81 +0,0 @@ -;;;; repo.scm -- tests for (cuirass repo) module -;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org> -;;; -;;; This file is part of Cuirass. -;;; -;;; Cuirass is free software: you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation, either version 3 of the License, or -;;; (at your option) any later version. -;;; -;;; Cuirass is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; 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 repo) - (cuirass utils) - (guix store) - (srfi srfi-64)) - -(test-begin "repo") - -(test-equal "<repo> datatype" - ;; Check that all the procedures for manipulating <repo> objects are - ;; exported and that the keywords of the constructor matches their slot. - '(1 2 3 4 5 6) - (let ((obj (repo #:id 1 #:url 2 #:location 3 #:ref 4 - #:snapshoter 5 #:updater 6))) - (and (repo? obj) - (list (repo-id obj) - (repo-url obj) - (repo-location obj) - (repo-reference obj) - (repo-snapshoter obj) - (repo-updater obj))))) - -(define file-name - (pk (simple-format #f "tmp-~S" (getpid)))) - -(define store - (open-connection)) - -(define (create-file name) - "Create a dummy file in current directory." - (with-output-to-file name - (λ () (display "test!\n")))) - -(define (in-store? file-name) - "Check if FILE-NAME is in the store. FILE-NAME must be an absolute file -name." - (string-prefix? "/gnu/store" file-name)) - -;;; -;;; File repository. -;;; - -(test-group-with-cleanup "file-repo" - (define rpt (pk (file-repo file-name))) - - ;; Since file doesn't exist yet, 'repo-update' should throw an error. - (test-error "file-repo-update: file not found" - 'system-error - (repo-update rpt)) - - (create-file file-name) - - (test-assert "file-repo-update" - (repo-update rpt)) - - (test-assert "file-repo-snapshot" - (in-store? (repo-snapshot rpt store))) - - ;; Cleanup. - (delete-file file-name)) - -(close-connection store) - -(test-end) |