Commit | Line | Data |
---|---|---|
a132f7d6 | 1 | ;;; GNU Guix --- Functional package management for GNU |
5e892bc3 | 2 | ;;; Copyright © 2015, 2017 Ricardo Wurmus <rekado@elephly.net> |
a132f7d6 | 3 | ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com> |
bea3b177 | 4 | ;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> |
a132f7d6 BW |
5 | ;;; |
6 | ;;; This file is part of GNU Guix. | |
7 | ;;; | |
8 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
9 | ;;; under the terms of the GNU General Public License as published by | |
10 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
11 | ;;; your option) any later version. | |
12 | ;;; | |
13 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
14 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
16 | ;;; GNU General Public License for more details. | |
17 | ;;; | |
18 | ;;; You should have received a copy of the GNU General Public License | |
19 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
20 | ||
21 | (define-module (test-import-utils) | |
22 | #:use-module (guix tests) | |
23 | #:use-module (guix import utils) | |
11e296ef | 24 | #:use-module ((guix licenses) #:prefix license:) |
5e892bc3 RW |
25 | #:use-module (guix packages) |
26 | #:use-module (guix build-system) | |
81c3dc32 | 27 | #:use-module (gnu packages) |
ddd59159 LC |
28 | #:use-module (srfi srfi-64) |
29 | #:use-module (ice-9 match)) | |
a132f7d6 BW |
30 | |
31 | (test-begin "import-utils") | |
32 | ||
33 | (test-equal "beautify-description: use double spacing" | |
34 | "This is a package. It is great. Trust me Mr. Hendrix." | |
35 | (beautify-description | |
36 | "This is a package. It is great. Trust me Mr. Hendrix.")) | |
37 | ||
38 | (test-equal "beautify-description: transform fragment into sentence" | |
39 | "This package provides a function to establish world peace" | |
40 | (beautify-description "A function to establish world peace")) | |
41 | ||
11e296ef DC |
42 | (test-equal "license->symbol" |
43 | 'license:lgpl2.0 | |
44 | (license->symbol license:lgpl2.0)) | |
45 | ||
ddd59159 LC |
46 | (test-equal "recursive-import" |
47 | '((package ;package expressions in topological order | |
48 | (name "bar")) | |
49 | (package | |
50 | (name "foo") | |
51 | (inputs `(("bar" ,bar))))) | |
bea3b177 MB |
52 | (recursive-import "foo" |
53 | #:repo 'repo | |
70a8e132 LC |
54 | #:repo->guix-package |
55 | (match-lambda* | |
bea3b177 | 56 | (("foo" #:version #f #:repo 'repo) |
70a8e132 LC |
57 | (values '(package |
58 | (name "foo") | |
59 | (inputs `(("bar" ,bar)))) | |
60 | '("bar"))) | |
bea3b177 | 61 | (("bar" #:version #f #:repo 'repo) |
70a8e132 LC |
62 | (values '(package |
63 | (name "bar")) | |
64 | '()))) | |
65 | #:guix-name identity)) | |
ddd59159 | 66 | |
5e892bc3 RW |
67 | (test-assert "alist->package with simple source" |
68 | (let* ((meta '(("name" . "hello") | |
69 | ("version" . "2.10") | |
8b920d70 LC |
70 | ("source" . |
71 | ;; Use a 'file://' URI so that we don't cause a download. | |
72 | ,(string-append "file://" | |
73 | (search-path %load-path "guix.scm"))) | |
5e892bc3 RW |
74 | ("build-system" . "gnu") |
75 | ("home-page" . "https://gnu.org") | |
76 | ("synopsis" . "Say hi") | |
77 | ("description" . "This package says hi.") | |
78 | ("license" . "GPL-3.0+"))) | |
79 | (pkg (alist->package meta))) | |
80 | (and (package? pkg) | |
81 | (license:license? (package-license pkg)) | |
82 | (build-system? (package-build-system pkg)) | |
83 | (origin? (package-source pkg))))) | |
84 | ||
85 | (test-assert "alist->package with explicit source" | |
86 | (let* ((meta '(("name" . "hello") | |
87 | ("version" . "2.10") | |
88 | ("source" . (("method" . "url-fetch") | |
89 | ("uri" . "mirror://gnu/hello/hello-2.10.tar.gz") | |
90 | ("sha256" . | |
91 | (("base32" . | |
92 | "0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i"))))) | |
93 | ("build-system" . "gnu") | |
94 | ("home-page" . "https://gnu.org") | |
95 | ("synopsis" . "Say hi") | |
96 | ("description" . "This package says hi.") | |
97 | ("license" . "GPL-3.0+"))) | |
98 | (pkg (alist->package meta))) | |
99 | (and (package? pkg) | |
100 | (license:license? (package-license pkg)) | |
101 | (build-system? (package-build-system pkg)) | |
102 | (origin? (package-source pkg)) | |
103 | (equal? (origin-sha256 (package-source pkg)) | |
104 | (base32 "0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i"))))) | |
105 | ||
5e2495d0 LC |
106 | (test-equal "alist->package with false license" ;<https://bugs.gnu.org/30470> |
107 | 'license-is-false | |
108 | (let* ((meta '(("name" . "hello") | |
109 | ("version" . "2.10") | |
110 | ("source" . (("method" . "url-fetch") | |
111 | ("uri" . "mirror://gnu/hello/hello-2.10.tar.gz") | |
112 | ("sha256" . | |
113 | (("base32" . | |
114 | "0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i"))))) | |
115 | ("build-system" . "gnu") | |
116 | ("home-page" . "https://gnu.org") | |
117 | ("synopsis" . "Say hi") | |
118 | ("description" . "This package says hi.") | |
119 | ("license" . #f)))) | |
120 | ;; Note: Use 'or' because comparing with #f otherwise succeeds when | |
121 | ;; there's an exception instead of an actual #f. | |
122 | (or (package-license (alist->package meta)) | |
123 | 'license-is-false))) | |
124 | ||
81c3dc32 LC |
125 | (test-equal "alist->package with dependencies" |
126 | `(("gettext" ,(specification->package "gettext"))) | |
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 | ; | |
139 | ;; Note: As with Guile-JSON 3.x, JSON arrays are represented | |
140 | ;; by vectors. | |
141 | ("native-inputs" . #("gettext")) | |
142 | ||
143 | ("license" . #f)))) | |
144 | (package-native-inputs (alist->package meta)))) | |
145 | ||
a132f7d6 | 146 | (test-end "import-utils") |