Commit | Line | Data |
---|---|---|
a132f7d6 | 1 | ;;; GNU Guix --- Functional package management for GNU |
421a87a6 | 2 | ;;; Copyright © 2015, 2017, 2022 Ricardo Wurmus <rekado@elephly.net> |
a132f7d6 | 3 | ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com> |
bea3b177 | 4 | ;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> |
f95bdeb9 | 5 | ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev> |
a132f7d6 BW |
6 | ;;; |
7 | ;;; This file is part of GNU Guix. | |
8 | ;;; | |
9 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
10 | ;;; under the terms of the GNU General Public License as published by | |
11 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
12 | ;;; your option) any later version. | |
13 | ;;; | |
14 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
15 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 | ;;; GNU General Public License for more details. | |
18 | ;;; | |
19 | ;;; You should have received a copy of the GNU General Public License | |
20 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
21 | ||
22 | (define-module (test-import-utils) | |
23 | #:use-module (guix tests) | |
24 | #:use-module (guix import utils) | |
11e296ef | 25 | #:use-module ((guix licenses) #:prefix license:) |
5e892bc3 RW |
26 | #:use-module (guix packages) |
27 | #:use-module (guix build-system) | |
81c3dc32 | 28 | #:use-module (gnu packages) |
ddd59159 LC |
29 | #:use-module (srfi srfi-64) |
30 | #:use-module (ice-9 match)) | |
a132f7d6 BW |
31 | |
32 | (test-begin "import-utils") | |
33 | ||
34 | (test-equal "beautify-description: use double spacing" | |
421a87a6 RW |
35 | "\ |
36 | Trust me Mr. Hendrix, M. Night Shyamalan et al. \ | |
37 | Differences are hard to spot, | |
38 | e.g. in CLOS vs. GOOPS." | |
a132f7d6 | 39 | (beautify-description |
421a87a6 RW |
40 | " |
41 | Trust me Mr. Hendrix, M. Night Shyamalan et al. \ | |
42 | Differences are hard to spot, e.g. in CLOS vs. GOOPS.")) | |
a132f7d6 BW |
43 | |
44 | (test-equal "beautify-description: transform fragment into sentence" | |
45 | "This package provides a function to establish world peace" | |
46 | (beautify-description "A function to establish world peace")) | |
47 | ||
421a87a6 RW |
48 | (test-equal "beautify-description: remove single quotes" |
49 | "CRAN likes to quote acronyms and function names." | |
50 | (beautify-description "CRAN likes to 'quote' acronyms and 'function' names.")) | |
51 | ||
52 | (test-equal "beautify-description: escape @" | |
53 | "This @@ is not Texinfo syntax. Neither is this %@@>%." | |
54 | (beautify-description "This @ is not Texinfo syntax. Neither is this %@>%.")) | |
55 | ||
11e296ef DC |
56 | (test-equal "license->symbol" |
57 | 'license:lgpl2.0 | |
58 | (license->symbol license:lgpl2.0)) | |
59 | ||
ddd59159 LC |
60 | (test-equal "recursive-import" |
61 | '((package ;package expressions in topological order | |
62 | (name "bar")) | |
63 | (package | |
64 | (name "foo") | |
65 | (inputs `(("bar" ,bar))))) | |
bea3b177 MB |
66 | (recursive-import "foo" |
67 | #:repo 'repo | |
70a8e132 LC |
68 | #:repo->guix-package |
69 | (match-lambda* | |
bea3b177 | 70 | (("foo" #:version #f #:repo 'repo) |
70a8e132 LC |
71 | (values '(package |
72 | (name "foo") | |
73 | (inputs `(("bar" ,bar)))) | |
74 | '("bar"))) | |
bea3b177 | 75 | (("bar" #:version #f #:repo 'repo) |
70a8e132 LC |
76 | (values '(package |
77 | (name "bar")) | |
78 | '()))) | |
79 | #:guix-name identity)) | |
ddd59159 | 80 | |
f95bdeb9 SM |
81 | (test-equal "recursive-import: skip false packages (toplevel)" |
82 | '() | |
83 | (recursive-import "foo" | |
84 | #:repo 'repo | |
85 | #:repo->guix-package | |
86 | (match-lambda* | |
87 | (("foo" #:version #f #:repo 'repo) | |
88 | (values #f '()))) | |
89 | #:guix-name identity)) | |
90 | ||
91 | (test-equal "recursive-import: skip false packages (dependency)" | |
92 | '((package | |
93 | (name "foo") | |
94 | (inputs `(("bar" ,bar))))) | |
95 | (recursive-import "foo" | |
96 | #:repo 'repo | |
97 | #:repo->guix-package | |
98 | (match-lambda* | |
99 | (("foo" #:version #f #:repo 'repo) | |
100 | (values '(package | |
101 | (name "foo") | |
102 | (inputs `(("bar" ,bar)))) | |
103 | '("bar"))) | |
104 | (("bar" #:version #f #:repo 'repo) | |
105 | (values #f '()))) | |
106 | #:guix-name identity)) | |
107 | ||
5e892bc3 RW |
108 | (test-assert "alist->package with simple source" |
109 | (let* ((meta '(("name" . "hello") | |
110 | ("version" . "2.10") | |
8b920d70 LC |
111 | ("source" . |
112 | ;; Use a 'file://' URI so that we don't cause a download. | |
113 | ,(string-append "file://" | |
114 | (search-path %load-path "guix.scm"))) | |
5e892bc3 RW |
115 | ("build-system" . "gnu") |
116 | ("home-page" . "https://gnu.org") | |
117 | ("synopsis" . "Say hi") | |
118 | ("description" . "This package says hi.") | |
119 | ("license" . "GPL-3.0+"))) | |
120 | (pkg (alist->package meta))) | |
121 | (and (package? pkg) | |
122 | (license:license? (package-license pkg)) | |
123 | (build-system? (package-build-system pkg)) | |
124 | (origin? (package-source pkg))))) | |
125 | ||
126 | (test-assert "alist->package with explicit source" | |
127 | (let* ((meta '(("name" . "hello") | |
128 | ("version" . "2.10") | |
129 | ("source" . (("method" . "url-fetch") | |
130 | ("uri" . "mirror://gnu/hello/hello-2.10.tar.gz") | |
131 | ("sha256" . | |
132 | (("base32" . | |
133 | "0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i"))))) | |
134 | ("build-system" . "gnu") | |
135 | ("home-page" . "https://gnu.org") | |
136 | ("synopsis" . "Say hi") | |
137 | ("description" . "This package says hi.") | |
138 | ("license" . "GPL-3.0+"))) | |
139 | (pkg (alist->package meta))) | |
140 | (and (package? pkg) | |
141 | (license:license? (package-license pkg)) | |
142 | (build-system? (package-build-system pkg)) | |
143 | (origin? (package-source pkg)) | |
144 | (equal? (origin-sha256 (package-source pkg)) | |
145 | (base32 "0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i"))))) | |
146 | ||
5e2495d0 LC |
147 | (test-equal "alist->package with false license" ;<https://bugs.gnu.org/30470> |
148 | 'license-is-false | |
149 | (let* ((meta '(("name" . "hello") | |
150 | ("version" . "2.10") | |
151 | ("source" . (("method" . "url-fetch") | |
152 | ("uri" . "mirror://gnu/hello/hello-2.10.tar.gz") | |
153 | ("sha256" . | |
154 | (("base32" . | |
155 | "0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i"))))) | |
156 | ("build-system" . "gnu") | |
157 | ("home-page" . "https://gnu.org") | |
158 | ("synopsis" . "Say hi") | |
159 | ("description" . "This package says hi.") | |
160 | ("license" . #f)))) | |
161 | ;; Note: Use 'or' because comparing with #f otherwise succeeds when | |
162 | ;; there's an exception instead of an actual #f. | |
163 | (or (package-license (alist->package meta)) | |
164 | 'license-is-false))) | |
165 | ||
5aae6148 RW |
166 | (test-equal "alist->package with SPDX license name 1/2" ;<https://bugs.gnu.org/45453> |
167 | license:expat | |
168 | (let* ((meta '(("name" . "hello") | |
169 | ("version" . "2.10") | |
170 | ("source" . (("method" . "url-fetch") | |
171 | ("uri" . "mirror://gnu/hello/hello-2.10.tar.gz") | |
172 | ("sha256" . | |
173 | (("base32" . | |
174 | "0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i"))))) | |
175 | ("build-system" . "gnu") | |
176 | ("home-page" . "https://gnu.org") | |
177 | ("synopsis" . "Say hi") | |
178 | ("description" . "This package says hi.") | |
179 | ("license" . "expat")))) | |
180 | (package-license (alist->package meta)))) | |
181 | ||
182 | (test-equal "alist->package with SPDX license name 2/2" ;<https://bugs.gnu.org/45453> | |
183 | license:expat | |
184 | (let* ((meta '(("name" . "hello") | |
185 | ("version" . "2.10") | |
186 | ("source" . (("method" . "url-fetch") | |
187 | ("uri" . "mirror://gnu/hello/hello-2.10.tar.gz") | |
188 | ("sha256" . | |
189 | (("base32" . | |
190 | "0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i"))))) | |
191 | ("build-system" . "gnu") | |
192 | ("home-page" . "https://gnu.org") | |
193 | ("synopsis" . "Say hi") | |
194 | ("description" . "This package says hi.") | |
195 | ("license" . "MIT")))) | |
196 | (package-license (alist->package meta)))) | |
197 | ||
81c3dc32 LC |
198 | (test-equal "alist->package with dependencies" |
199 | `(("gettext" ,(specification->package "gettext"))) | |
200 | (let* ((meta '(("name" . "hello") | |
201 | ("version" . "2.10") | |
202 | ("source" . (("method" . "url-fetch") | |
203 | ("uri" . "mirror://gnu/hello/hello-2.10.tar.gz") | |
204 | ("sha256" . | |
205 | (("base32" . | |
206 | "0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i"))))) | |
207 | ("build-system" . "gnu") | |
208 | ("home-page" . "https://gnu.org") | |
209 | ("synopsis" . "Say hi") | |
210 | ("description" . "This package says hi.") | |
211 | ; | |
212 | ;; Note: As with Guile-JSON 3.x, JSON arrays are represented | |
213 | ;; by vectors. | |
214 | ("native-inputs" . #("gettext")) | |
215 | ||
216 | ("license" . #f)))) | |
217 | (package-native-inputs (alist->package meta)))) | |
218 | ||
61bd7bf4 | 219 | (test-assert "alist->package with properties" |
220 | (let* ((meta '(("name" . "hello") | |
221 | ("version" . "2.10") | |
222 | ("source" . | |
223 | ;; Use a 'file://' URI so that we don't cause a download. | |
224 | ,(string-append "file://" | |
225 | (search-path %load-path "guix.scm"))) | |
226 | ("build-system" . "gnu") | |
227 | ("properties" . (("hidden?" . #t) | |
228 | ("upstream-name" . "hello-upstream"))) | |
229 | ("home-page" . "https://gnu.org") | |
230 | ("synopsis" . "Say hi") | |
231 | ("description" . "This package says hi.") | |
232 | ("license" . "GPL-3.0+"))) | |
233 | (pkg (alist->package meta))) | |
234 | (and (package? pkg) | |
235 | (equal? (package-upstream-name pkg) "hello-upstream") | |
236 | (hidden-package? pkg)))) | |
237 | ||
07482dc0 | 238 | (test-equal "spdx-string->license" |
fd5e6425 | 239 | '(license:gpl3+ license:agpl3 license:gpl2+) |
07482dc0 | 240 | (map spdx-string->license |
fd5e6425 | 241 | '("GPL-3.0-oR-LaTeR" "AGPL-3.0" "GPL-2.0+"))) |
07482dc0 | 242 | |
a132f7d6 | 243 | (test-end "import-utils") |