tests/import-github.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
   3 ;;;
   4 ;;; This file is part of GNU Guix.
   5 ;;;
   6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   7 ;;; under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 3 of the License, or (at
   9 ;;; your option) any later version.
  10 ;;;
  11 ;;; GNU Guix is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 (define-module (test-import-github)
  20   #:use-module (json)
  21   #:use-module (srfi srfi-35)
  22   #:use-module (srfi srfi-64)
  23   #:use-module (guix git-download)
  24   #:use-module (guix http-client)
  25   #:use-module (guix import github)
  26   #:use-module (guix packages)
  27   #:use-module (guix tests)
  28   #:use-module (guix upstream)
  29   #:use-module (ice-9 match))
  30
  31 (test-begin "github")
  32
  33 (define (call-with-releases thunk tags releases)
  34   (mock ((guix http-client) http-fetch
  35          (lambda* (uri #:key headers)
  36            (unless (string-prefix? "mock://" uri)
  37              (error "the URI ~a should not be used" uri))
  38            (define components
  39              (string-split (substring uri 8) #\/))
  40            (pk 'stuff components headers)
  41            (define (scm->json-port scm)
  42              (open-input-string (scm->json-string scm)))
  43            (match components
  44              (("repos" "foo" "foomatics" "releases")
  45               (scm->json-port releases))
  46              (("repos" "foo" "foomatics" "tags")
  47               (scm->json-port tags))
  48              (rest (error "TODO ~a" rest)))))
  49         (parameterize ((%github-api "mock://"))
  50           (thunk))))
  51
  52 ;; Copied from tests/minetest.scm
  53 (define (upstream-source->sexp upstream-source)
  54   (define url (upstream-source-urls upstream-source))
  55   (unless (git-reference? url)
  56     (error "a <git-reference> is expected"))
  57   `(,(upstream-source-package upstream-source)
  58     ,(upstream-source-version upstream-source)
  59     ,(git-reference-url url)
  60     ,(git-reference-commit url)))
  61
  62 (define* (expected-sexp new-version new-commit)
  63   `("foomatics" ,new-version "https://github.com/foo/foomatics" ,new-commit))
  64
  65 (define (example-package old-version old-commit)
  66   (package
  67     (name "foomatics")
  68     (version old-version)
  69     (source
  70      (origin
  71        (method git-fetch)
  72        (uri (git-reference
  73              (url "https://github.com/foo/foomatics")
  74              (commit old-commit)))
  75        (sha256 #f) ; not important for following tests
  76        (file-name (git-file-name name version))))
  77     (build-system #f)
  78     (license #f)
  79     (synopsis #f)
  80     (description #f)
  81     (home-page #f)))
  82
  83 (define* (found-sexp old-version old-commit tags releases)
  84   (and=>
  85    (call-with-releases (lambda ()
  86                          ((upstream-updater-latest %github-updater)
  87                           (example-package old-version old-commit)))
  88                        tags releases)
  89    upstream-source->sexp))
  90
  91 (define-syntax-rule (test-release test-case old-version
  92                                   old-commit new-version new-commit
  93                                   tags releases)
  94   (test-equal test-case
  95     (expected-sexp new-version new-commit)
  96     (found-sexp old-version old-commit tags releases)))
  97
  98 (test-release "newest release is choosen"
  99   "1.0.0" "v1.0.0" "1.9" "v1.9"
 100   #()
 101   ;; a mixture of current, older and newer versions
 102   #((("tag_name" . "v0.0"))
 103     (("tag_name" . "v1.0.1"))
 104     (("tag_name" . "v1.9"))
 105     (("tag_name" . "v1.0.0"))
 106     (("tag_name" . "v1.0.2"))))
 107
 108 (test-release "tags are used when there are no formal releases"
 109   "1.0.0" "v1.0.0" "1.9" "v1.9"
 110   ;; a mixture of current, older and newer versions
 111   #((("name" . "v0.0"))
 112     (("name" . "v1.0.1"))
 113     (("name" . "v1.9"))
 114     (("name" . "v1.0.0"))
 115     (("name" . "v1.0.2")))
 116   #())
 117
 118 (test-release "\"version-\" prefixes are recognised"
 119   "1.0.0" "v1.0.0" "1.9" "version-1.9"
 120   #((("name" . "version-1.9")))
 121   #())
 122
 123 (test-release "prefixes are optional"
 124   "1.0.0" "v1.0.0" "1.9" "1.9"
 125   #((("name" . "1.9")))
 126   #())
 127
 128 (test-release "prefixing by package name is acceptable"
 129   "1.0.0" "v1.0.0" "1.9" "foomatics-1.9"
 130   #((("name" . "foomatics-1.9")))
 131   #())
 132
 133 (test-release "not all prefixes are acceptable"
 134   "1.0.0" "v1.0.0" "1.0.0" "v1.0.0"
 135   #((("name" . "v1.0.0"))
 136     (("name" . "barstatics-1.9")))
 137   #())
 138
 139 (test-end "github")