Commit | Line | Data |
---|---|---|
f1eacbaf LC |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org> | |
a6bf1c10 | 3 | ;;; Copyright © 2022 Ricardo Wurmus <rekado@elephly.net> |
f1eacbaf 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-upstream) | |
a6bf1c10 RW |
21 | #:use-module (gnu packages base) |
22 | #:use-module (guix download) | |
23 | #:use-module (guix packages) | |
24 | #:use-module (guix build-system gnu) | |
25 | #:use-module (guix import print) | |
26 | #:use-module ((guix licenses) #:prefix license:) | |
f1eacbaf LC |
27 | #:use-module (guix upstream) |
28 | #:use-module (guix tests) | |
a6bf1c10 RW |
29 | #:use-module (srfi srfi-64) |
30 | #:use-module (ice-9 match)) | |
f1eacbaf LC |
31 | |
32 | \f | |
33 | (test-begin "upstream") | |
34 | ||
ea6fb108 LC |
35 | ;; FIXME: Temporarily skipping this test; see <https://bugs.gnu.org/34229>. |
36 | (test-skip 1) | |
37 | ||
f1eacbaf LC |
38 | (test-equal "coalesce-sources same version" |
39 | (list (upstream-source | |
40 | (package "foo") (version "1") | |
41 | (urls '("ftp://example.org/foo-1.tar.xz" | |
42 | "ftp://example.org/foo-1.tar.gz")) | |
43 | (signature-urls '("ftp://example.org/foo-1.tar.xz.sig" | |
44 | "ftp://example.org/foo-1.tar.gz.sig")))) | |
45 | ||
46 | (coalesce-sources (list (upstream-source | |
47 | (package "foo") (version "1") | |
48 | (urls '("ftp://example.org/foo-1.tar.gz")) | |
49 | (signature-urls | |
50 | '("ftp://example.org/foo-1.tar.gz.sig"))) | |
51 | (upstream-source | |
52 | (package "foo") (version "1") | |
53 | (urls '("ftp://example.org/foo-1.tar.xz")) | |
54 | (signature-urls | |
55 | '("ftp://example.org/foo-1.tar.xz.sig")))))) | |
56 | ||
a6bf1c10 RW |
57 | (define test-package |
58 | (package | |
59 | (name "test") | |
60 | (version "2.10") | |
61 | (source (origin | |
62 | (method url-fetch) | |
63 | (uri (string-append "mirror://gnu/hello/hello-" version | |
64 | ".tar.gz")) | |
65 | (sha256 | |
66 | (base32 | |
67 | "0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i")))) | |
68 | (build-system gnu-build-system) | |
69 | (inputs | |
70 | `(("hello" ,hello))) | |
71 | (native-inputs | |
72 | `(("sed" ,sed) | |
73 | ("tar" ,tar))) | |
74 | (propagated-inputs | |
75 | `(("grep" ,grep))) | |
76 | (home-page "http://localhost") | |
77 | (synopsis "test") | |
78 | (description "test") | |
79 | (license license:gpl3+))) | |
80 | ||
81 | (define test-package-sexp | |
82 | '(package | |
83 | (name "test") | |
84 | (version "2.10") | |
85 | (source (origin | |
86 | (method url-fetch) | |
87 | (uri (string-append "mirror://gnu/hello/hello-" version | |
88 | ".tar.gz")) | |
89 | (sha256 | |
90 | (base32 | |
91 | "0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i")))) | |
92 | (build-system gnu-build-system) | |
93 | (inputs | |
94 | `(("hello" ,hello))) | |
95 | (native-inputs | |
96 | `(("sed" ,sed) | |
97 | ("tar" ,tar))) | |
98 | (propagated-inputs | |
99 | `(("grep" ,grep))) | |
100 | (home-page "http://localhost") | |
101 | (synopsis "test") | |
102 | (description "test") | |
103 | (license license:gpl3+))) | |
104 | ||
105 | (test-equal "changed-inputs returns no changes" | |
106 | '() | |
107 | (changed-inputs test-package test-package-sexp)) | |
108 | ||
109 | (test-assert "changed-inputs returns changes to labelled input list" | |
110 | (let ((changes (changed-inputs | |
111 | (package | |
112 | (inherit test-package) | |
113 | (inputs `(("hello" ,hello) | |
114 | ("sed" ,sed)))) | |
115 | test-package-sexp))) | |
116 | (match changes | |
117 | ;; Exactly one change | |
118 | (((? upstream-input-change? item)) | |
119 | (and (equal? (upstream-input-change-type item) | |
120 | 'regular) | |
121 | (equal? (upstream-input-change-action item) | |
122 | 'remove) | |
123 | (string=? (upstream-input-change-name item) | |
124 | "sed"))) | |
125 | (else (pk else #false))))) | |
126 | ||
127 | (test-assert "changed-inputs returns changes to all labelled input lists" | |
128 | (let ((changes (changed-inputs | |
129 | (package | |
130 | (inherit test-package) | |
131 | (inputs '()) | |
132 | (native-inputs '()) | |
133 | (propagated-inputs '())) | |
134 | test-package-sexp))) | |
135 | (match changes | |
136 | (((? upstream-input-change? items) ...) | |
137 | (and (equal? (map upstream-input-change-type items) | |
138 | '(regular native native propagated)) | |
139 | (equal? (map upstream-input-change-action items) | |
140 | '(add add add add)) | |
141 | (equal? (map upstream-input-change-name items) | |
142 | '("hello" "sed" "tar" "grep")))) | |
143 | (else (pk else #false))))) | |
144 | ||
6226df77 RW |
145 | (define test-new-package |
146 | (package | |
147 | (inherit test-package) | |
148 | (inputs | |
149 | (list hello)) | |
150 | (native-inputs | |
151 | (list sed tar)) | |
152 | (propagated-inputs | |
153 | (list grep)))) | |
154 | ||
155 | (define test-new-package-sexp | |
156 | '(package | |
157 | (name "test") | |
158 | (version "2.10") | |
159 | (source (origin | |
160 | (method url-fetch) | |
161 | (uri (string-append "mirror://gnu/hello/hello-" version | |
162 | ".tar.gz")) | |
163 | (sha256 | |
164 | (base32 | |
165 | "0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i")))) | |
166 | (build-system gnu-build-system) | |
167 | (inputs | |
168 | (list hello)) | |
169 | (native-inputs | |
170 | (list sed tar)) | |
171 | (propagated-inputs | |
172 | (list grep)) | |
173 | (home-page "http://localhost") | |
174 | (synopsis "test") | |
175 | (description "test") | |
176 | (license license:gpl3+))) | |
177 | ||
178 | (test-assert "changed-inputs returns changes to plain input list" | |
179 | (let ((changes (changed-inputs | |
180 | (package | |
181 | (inherit test-new-package) | |
182 | (inputs (list hello sed))) | |
183 | test-new-package-sexp))) | |
184 | (match changes | |
185 | ;; Exactly one change | |
186 | (((? upstream-input-change? item)) | |
187 | (and (equal? (upstream-input-change-type item) | |
188 | 'regular) | |
189 | (equal? (upstream-input-change-action item) | |
190 | 'remove) | |
191 | (string=? (upstream-input-change-name item) | |
192 | "sed"))) | |
193 | (else (pk else #false))))) | |
194 | ||
195 | (test-assert "changed-inputs returns changes to all plain input lists" | |
196 | (let ((changes (changed-inputs | |
197 | (package | |
198 | (inherit test-new-package) | |
199 | (inputs '()) | |
200 | (native-inputs '()) | |
201 | (propagated-inputs '())) | |
202 | test-new-package-sexp))) | |
203 | (match changes | |
204 | (((? upstream-input-change? items) ...) | |
205 | (and (equal? (map upstream-input-change-type items) | |
206 | '(regular native native propagated)) | |
207 | (equal? (map upstream-input-change-action items) | |
208 | '(add add add add)) | |
209 | (equal? (map upstream-input-change-name items) | |
210 | '("hello" "sed" "tar" "grep")))) | |
211 | (else (pk else #false))))) | |
212 | ||
f1eacbaf | 213 | (test-end) |