Commit | Line | Data |
---|---|---|
202440e0 | 1 | ;;; GNU Guix --- Functional package management for GNU |
1710e8cb | 2 | ;;; Copyright © 2015, 2021 Ludovic Courtès <ludo@gnu.org> |
c967d115 | 3 | ;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be> |
202440e0 LC |
4 | ;;; |
5 | ;;; This file is part of GNU Guix. | |
6 | ;;; | |
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. | |
11 | ;;; | |
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. | |
16 | ;;; | |
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/>. | |
19 | ||
20 | (define-module (test-gnu-maintenance) | |
21 | #:use-module (guix gnu-maintenance) | |
c967d115 MD |
22 | #:use-module (guix tests) |
23 | #:use-module (guix tests http) | |
24 | #:use-module (guix upstream) | |
25 | #:use-module (guix utils) | |
202440e0 | 26 | #:use-module (srfi srfi-1) |
ceeea60b LC |
27 | #:use-module (srfi srfi-64) |
28 | #:use-module (ice-9 match)) | |
202440e0 LC |
29 | |
30 | (test-begin "gnu-maintenance") | |
31 | ||
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") | |
1710e8cb | 38 | ("mit-scheme" "mit-scheme-9.2.tar.gz") |
1575da60 | 39 | ("mediainfo" "mediainfo_20.09.tar.xz") |
ceeea60b LC |
40 | ("exiv2" "exiv2-0.27.3-Source.tar.gz") |
41 | ("mpg321" "mpg321_0.3.2.orig.tar.gz") | |
d7c356ed LC |
42 | ("bvi" "bvi-1.4.1.src.tar.gz") |
43 | ("hostscope" "hostscope-V2.1.tgz"))) | |
202440e0 LC |
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"))))) | |
51 | ||
ceeea60b LC |
52 | (test-assert "tarball->version" |
53 | (let ((tarball->version (@@ (guix gnu-maintenance) tarball->version))) | |
54 | (every (match-lambda | |
55 | ((file 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"))))) | |
62 | ||
c967d115 MD |
63 | (test-assert "latest-html-release, scheme-less URIs" |
64 | (with-http-server | |
65 | `((200 "<html xmlns=\"http://www.w3.org/1999/xhtml\"> | |
66 | <head> | |
67 | <title>Releases (on another domain)!</title> | |
68 | </head> | |
69 | <body | |
70 | <a href=\"//another-site/foo-2.tar.gz\">version 1</a> | |
71 | </body> | |
72 | </html>")) | |
73 | (let () | |
74 | (define package | |
75 | (dummy-package "foo" | |
76 | (source | |
77 | (dummy-origin | |
78 | (uri (string-append (%local-url) "/foo-1.tar.gz")))) | |
79 | (properties | |
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") | |
83 | (and (pk 'u update) | |
84 | (equal? (upstream-source-version update) "2") | |
85 | (equal? (list expected-new-url) (upstream-source-urls update)))))) | |
86 | ||
5c37ad81 MD |
87 | (test-assert "latest-html-release, no signature" |
88 | (with-http-server | |
89 | `((200 "<html xmlns=\"http://www.w3.org/1999/xhtml\"> | |
90 | <head> | |
91 | <title>Releases!</title> | |
92 | </head> | |
93 | <body> | |
94 | <a href=\"bar/foo-1.tar.gz\">version 1</a> | |
95 | <a href=\"bar/foo-2.tar.gz\">version 2</a> | |
96 | </body> | |
97 | </html>")) | |
98 | (let () | |
99 | (define package | |
100 | (dummy-package "foo" | |
101 | (source | |
102 | (dummy-origin | |
103 | (uri (string-append (%local-url) "/foo-1.tar.gz")))) | |
104 | (properties | |
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")) | |
109 | (and (pk 'u update) | |
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) '())))))) | |
115 | ||
116 | (test-assert "latest-html-release, signature" | |
117 | (with-http-server | |
118 | `((200 "<html xmlns=\"http://www.w3.org/1999/xhtml\"> | |
119 | <head> | |
120 | <title>Signed releases!</title> | |
121 | </head> | |
122 | <body> | |
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> | |
127 | </body> | |
128 | </html>")) | |
129 | (let () | |
130 | (define package | |
131 | (dummy-package "foo" | |
132 | (source | |
133 | (dummy-origin | |
134 | (uri (string-append (%local-url) "/foo-1.tar.gz")))) | |
135 | (properties | |
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")) | |
142 | (and (pk 'u update) | |
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)))))) | |
148 | ||
202440e0 | 149 | (test-end) |