diff options
| -rw-r--r-- | Makefile.am | 1 | ||||
| -rw-r--r-- | guix/import/github.scm | 9 | ||||
| -rw-r--r-- | tests/import-github.scm | 139 |
3 files changed, 146 insertions, 3 deletions
diff --git a/Makefile.am b/Makefile.am index 077586eda7..a10aeb817b 100644 --- a/Makefile.am +++ b/Makefile.am @@ -483,6 +483,7 @@ SCM_TESTS = \ tests/hackage.scm \ tests/home-import.scm \ tests/import-git.scm \ + tests/import-github.scm \ tests/import-utils.scm \ tests/inferior.scm \ tests/lint.scm \ diff --git a/guix/import/github.scm b/guix/import/github.scm index 1adfb8d281..8c1898c0c5 100644 --- a/guix/import/github.scm +++ b/guix/import/github.scm @@ -39,7 +39,10 @@ #:use-module (guix upstream) #:use-module (guix http-client) #:use-module (web uri) - #:export (%github-updater)) + #:export (%github-api %github-updater)) + +;; For tests. +(define %github-api (make-parameter "https://api.github.com")) (define (find-extension url) "Return the extension of the archive e.g. '.tar.gz' given a URL, or @@ -150,11 +153,11 @@ tags show up in the \"Releases\" tab of the web UI. For instance, 'https://api.github.com/repos/aconchillo/guile-json/releases' returns the empty list." (define release-url - (string-append "https://api.github.com/repos/" + (string-append (%github-api) "/repos/" (github-user-slash-repository url) "/releases")) (define tag-url - (string-append "https://api.github.com/repos/" + (string-append (%github-api) "/repos/" (github-user-slash-repository url) "/tags")) diff --git a/tests/import-github.scm b/tests/import-github.scm new file mode 100644 index 0000000000..979a0fc12b --- /dev/null +++ b/tests/import-github.scm @@ -0,0 +1,139 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix 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. +;;; +;;; GNU Guix 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 GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (test-import-github) + #:use-module (json) + #:use-module (srfi srfi-35) + #:use-module (srfi srfi-64) + #:use-module (guix git-download) + #:use-module (guix http-client) + #:use-module (guix import github) + #:use-module (guix packages) + #:use-module (guix tests) + #:use-module (guix upstream) + #:use-module (ice-9 match)) + +(test-begin "github") + +(define (call-with-releases thunk tags releases) + (mock ((guix http-client) http-fetch + (lambda* (uri #:key headers) + (unless (string-prefix? "mock://" uri) + (error "the URI ~a should not be used" uri)) + (define components + (string-split (substring uri 8) #\/)) + (pk 'stuff components headers) + (define (scm->json-port scm) + (open-input-string (scm->json-string scm))) + (match components + (("repos" "foo" "foomatics" "releases") + (scm->json-port releases)) + (("repos" "foo" "foomatics" "tags") + (scm->json-port tags)) + (rest (error "TODO ~a" rest))))) + (parameterize ((%github-api "mock://")) + (thunk)))) + +;; Copied from tests/minetest.scm +(define (upstream-source->sexp upstream-source) + (define url (upstream-source-urls upstream-source)) + (unless (git-reference? url) + (error "a <git-reference> is expected")) + `(,(upstream-source-package upstream-source) + ,(upstream-source-version upstream-source) + ,(git-reference-url url) + ,(git-reference-commit url))) + +(define* (expected-sexp new-version new-commit) + `("foomatics" ,new-version "https://github.com/foo/foomatics" ,new-commit)) + +(define (example-package old-version old-commit) + (package + (name "foomatics") + (version old-version) + (source + (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/foo/foomatics") + (commit old-commit))) + (sha256 #f) ; not important for following tests + (file-name (git-file-name name version)))) + (build-system #f) + (license #f) + (synopsis #f) + (description #f) + (home-page #f))) + +(define* (found-sexp old-version old-commit tags releases) + (and=> + (call-with-releases (lambda () + ((upstream-updater-latest %github-updater) + (example-package old-version old-commit))) + tags releases) + upstream-source->sexp)) + +(define-syntax-rule (test-release test-case old-version + old-commit new-version new-commit + tags releases) + (test-equal test-case + (expected-sexp new-version new-commit) + (found-sexp old-version old-commit tags releases))) + +(test-release "newest release is choosen" + "1.0.0" "v1.0.0" "1.9" "v1.9" + #() + ;; a mixture of current, older and newer versions + #((("tag_name" . "v0.0")) + (("tag_name" . "v1.0.1")) + (("tag_name" . "v1.9")) + (("tag_name" . "v1.0.0")) + (("tag_name" . "v1.0.2")))) + +(test-release "tags are used when there are no formal releases" + "1.0.0" "v1.0.0" "1.9" "v1.9" + ;; a mixture of current, older and newer versions + #((("name" . "v0.0")) + (("name" . "v1.0.1")) + (("name" . "v1.9")) + (("name" . "v1.0.0")) + (("name" . "v1.0.2"))) + #()) + +(test-release "\"version-\" prefixes are recognised" + "1.0.0" "v1.0.0" "1.9" "version-1.9" + #((("name" . "version-1.9"))) + #()) + +(test-release "prefixes are optional" + "1.0.0" "v1.0.0" "1.9" "1.9" + #((("name" . "1.9"))) + #()) + +(test-release "prefixing by package name is acceptable" + "1.0.0" "v1.0.0" "1.9" "foomatics-1.9" + #((("name" . "foomatics-1.9"))) + #()) + +(test-release "not all prefixes are acceptable" + "1.0.0" "v1.0.0" "1.0.0" "v1.0.0" + #((("name" . "v1.0.0")) + (("name" . "barstatics-1.9"))) + #()) + +(test-end "github") |