1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2015, 2021 Ludovic Courtès <ludo@gnu.org>
3 ;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
5 ;;; This file is part of GNU Guix.
7 ;;; GNU Guix is free software; you can redistribute it and/or modify it
8 ;;; under the terms of the GNU General Public License as published by
9 ;;; the Free Software Foundation; either version 3 of the License, or (at
10 ;;; your option) any later version.
12 ;;; GNU Guix is distributed in the hope that it will be useful, but
13 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;;; GNU General Public License for more details.
17 ;;; You should have received a copy of the GNU General Public License
18 ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
20 (define-module (test-gnu-maintenance)
21 #:use-module (guix gnu-maintenance)
22 #:use-module (guix tests)
23 #:use-module (guix tests http)
24 #:use-module (guix upstream)
25 #:use-module (guix utils)
26 #:use-module (srfi srfi-1)
27 #:use-module (srfi srfi-64)
28 #:use-module (ice-9 match))
30 (test-begin "gnu-maintenance")
32 (test-assert "release-file?"
33 (and (every (lambda (project+file)
34 (apply release-file? project+file))
35 '(("gcc" "gcc-5.3.0.tar.bz2")
36 ("texmacs" "TeXmacs-1.0.7.9-src.tar.gz")
37 ("icecat" "icecat-38.4.0-gnu1.tar.bz2")
38 ("mit-scheme" "mit-scheme-9.2.tar.gz")
39 ("mediainfo" "mediainfo_20.09.tar.xz")
40 ("exiv2" "exiv2-0.27.3-Source.tar.gz")
41 ("mpg321" "mpg321_0.3.2.orig.tar.gz")
42 ("bvi" "bvi-1.4.1.src.tar.gz")
43 ("hostscope" "hostscope-V2.1.tgz")))
44 (every (lambda (project+file)
45 (not (apply release-file? project+file)))
46 '(("guile" "guile-www-1.1.1.tar.gz")
47 ("guile" "guile-2.0.11.tar.gz.sig")
48 ("mit-scheme" "mit-scheme-9.2-i386.tar.gz")
49 ("mit-scheme" "mit-scheme-9.2-doc-pdf.tar.gz")
50 ("gnutls" "gnutls-3.2.18-w32.zip")))))
52 (test-assert "tarball->version"
53 (let ((tarball->version (@@ (guix gnu-maintenance) tarball->version)))
56 (equal? (tarball->version file) version)))
57 '(("coreutils-8.32.tar.gz" "8.32")
58 ("mediainfo_20.09.tar.xz" "20.09")
59 ("exiv2-0.27.3-Source.tar.gz" "0.27.3")
60 ("mpg321_0.3.2.orig.tar.gz" "0.3.2")
61 ("bvi-1.4.1.src.tar.gz" "1.4.1")))))
63 (test-assert "latest-html-release, scheme-less URIs"
65 `((200 "<html xmlns=\"http://www.w3.org/1999/xhtml\">
67 <title>Releases (on another domain)!</title>
70 <a href=\"//another-site/foo-2.tar.gz\">version 1</a>
78 (uri (string-append (%local-url) "/foo-1.tar.gz"))))
80 `((release-monitoring-url . ,(%local-url))))))
81 (define update ((upstream-updater-latest %generic-html-updater) package))
82 (define expected-new-url "http://another-site/foo-2.tar.gz")
84 (equal? (upstream-source-version update) "2")
85 (equal? (list expected-new-url) (upstream-source-urls update))))))
87 (test-assert "latest-html-release, no signature"
89 `((200 "<html xmlns=\"http://www.w3.org/1999/xhtml\">
91 <title>Releases!</title>
94 <a href=\"bar/foo-1.tar.gz\">version 1</a>
95 <a href=\"bar/foo-2.tar.gz\">version 2</a>
103 (uri (string-append (%local-url) "/foo-1.tar.gz"))))
105 `((release-monitoring-url . ,(%local-url))))))
106 (define update ((upstream-updater-latest %generic-html-updater) package))
107 (define expected-new-url
108 (string-append (%local-url) "/foo-2.tar.gz"))
110 (equal? (upstream-source-version update) "2")
111 (equal? (list expected-new-url)
112 (upstream-source-urls update))
113 (null? ;; both #false and the empty list are acceptable
114 (or (upstream-source-signature-urls update) '()))))))
116 (test-assert "latest-html-release, signature"
118 `((200 "<html xmlns=\"http://www.w3.org/1999/xhtml\">
120 <title>Signed releases!</title>
123 <a href=\"bar/foo-1.tar.gz\">version 1</a>
124 <a href=\"bar/foo-2.tar.gz\">version 2</a>
125 <a href=\"bar/foo-1.tar.gz.sig\">version 1 signature</a>
126 <a href=\"bar/foo-2.tar.gz.sig\">version 2 signature</a>
134 (uri (string-append (%local-url) "/foo-1.tar.gz"))))
136 `((release-monitoring-url . ,(%local-url))))))
137 (define update ((upstream-updater-latest %generic-html-updater) package))
138 (define expected-new-url
139 (string-append (%local-url) "/foo-2.tar.gz"))
140 (define expected-signature-url
141 (string-append (%local-url) "/foo-2.tar.gz.sig"))
143 (equal? (upstream-source-version update) "2")
144 (equal? (list expected-new-url)
145 (upstream-source-urls update))
146 (equal? (list expected-signature-url)
147 (upstream-source-signature-urls update))))))