Commit | Line | Data |
---|---|---|
233e7676 | 1 | ;;; GNU Guix --- Functional package management for GNU |
d8fdd1c7 | 2 | ;;; Copyright © 2012, 2013, 2014, 2015, 2018, 2019, 2021 Ludovic Courtès <ludo@gnu.org> |
09448c09 | 3 | ;;; Copyright © 2021 Lars-Dominik Braun <lars@6xq.net> |
3eb98237 | 4 | ;;; |
233e7676 | 5 | ;;; This file is part of GNU Guix. |
3eb98237 | 6 | ;;; |
233e7676 | 7 | ;;; GNU Guix is free software; you can redistribute it and/or modify it |
3eb98237 LC |
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 | ;;; | |
233e7676 | 12 | ;;; GNU Guix is distributed in the hope that it will be useful, but |
3eb98237 LC |
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 | |
233e7676 | 18 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. |
3eb98237 LC |
19 | |
20 | ||
cfcead2e | 21 | (define-module (tests builders) |
62cab99c | 22 | #:use-module (guix download) |
208f7cd1 LC |
23 | #:use-module (guix build-system) |
24 | #:use-module (guix build-system gnu) | |
cfcead2e MC |
25 | #:use-module (guix build gnu-build-system) |
26 | #:use-module (guix build utils) | |
09448c09 | 27 | #:use-module (guix build-system python) |
3eb98237 | 28 | #:use-module (guix store) |
09448c09 | 29 | #:use-module (guix monads) |
3eb98237 | 30 | #:use-module (guix utils) |
ddc29a78 | 31 | #:use-module (guix base32) |
3eb98237 | 32 | #:use-module (guix derivations) |
ca719424 | 33 | #:use-module (gcrypt hash) |
c1bc358f | 34 | #:use-module (guix tests) |
09448c09 | 35 | #:use-module (guix packages) |
1ffa7090 | 36 | #:use-module (gnu packages bootstrap) |
8f3ecbd7 | 37 | #:use-module (ice-9 match) |
cfcead2e | 38 | #:use-module (ice-9 textual-ports) |
3eb98237 | 39 | #:use-module (srfi srfi-1) |
cfcead2e | 40 | #:use-module (srfi srfi-11) |
d8fdd1c7 | 41 | #:use-module (srfi srfi-34) |
3eb98237 LC |
42 | #:use-module (srfi srfi-64)) |
43 | ||
44 | ;; Test the higher-level builders. | |
45 | ||
46 | (define %store | |
c1bc358f | 47 | (open-connection-for-tests)) |
81dbd783 | 48 | |
f220a838 LC |
49 | (define url-fetch* |
50 | (store-lower url-fetch)) | |
51 | ||
14da91e2 | 52 | \f |
3eb98237 LC |
53 | (test-begin "builders") |
54 | ||
12d720fd | 55 | (unless (network-reachable?) (test-skip 1)) |
62cab99c LC |
56 | (test-assert "url-fetch" |
57 | (let* ((url '("http://ftp.gnu.org/gnu/hello/hello-2.8.tar.gz" | |
58 | "ftp://ftp.gnu.org/gnu/hello/hello-2.8.tar.gz")) | |
59 | (hash (nix-base32-string->bytevector | |
60 | "0wqd8sjmxfskrflaxywc7gqw7sfawrfvdxd9skxawzfgyy0pzdz6")) | |
f220a838 LC |
61 | (drv (url-fetch* %store url 'sha256 hash |
62 | #:guile %bootstrap-guile)) | |
59688fc4 LC |
63 | (out-path (derivation->output-path drv))) |
64 | (and (build-derivations %store (list drv)) | |
62cab99c LC |
65 | (file-exists? out-path) |
66 | (valid-path? %store out-path)))) | |
3eb98237 | 67 | |
882383a9 LC |
68 | (test-assert "url-fetch, file" |
69 | (let* ((file (search-path %load-path "guix.scm")) | |
70 | (hash (call-with-input-file file port-sha256)) | |
f220a838 | 71 | (out (url-fetch* %store file 'sha256 hash))) |
882383a9 LC |
72 | (and (file-exists? out) |
73 | (valid-path? %store out)))) | |
74 | ||
75 | (test-assert "url-fetch, file URI" | |
76 | (let* ((file (search-path %load-path "guix.scm")) | |
77 | (hash (call-with-input-file file port-sha256)) | |
f220a838 LC |
78 | (out (url-fetch* %store |
79 | (string-append "file://" (canonicalize-path file)) | |
80 | 'sha256 hash))) | |
882383a9 LC |
81 | (and (file-exists? out) |
82 | (valid-path? %store out)))) | |
83 | ||
208f7cd1 | 84 | (test-assert "gnu-build-system" |
0d5a559f | 85 | (build-system? gnu-build-system)) |
208f7cd1 | 86 | |
cfcead2e MC |
87 | (define unpack (assoc-ref %standard-phases 'unpack)) |
88 | ||
89 | (define compressors '(("gzip" . "gz") | |
90 | ("xz" . "xz") | |
91 | ("bzip2" . "bz2") | |
92 | (#f . #f))) | |
93 | ||
94 | (for-each | |
95 | (match-lambda | |
96 | ((comp . ext) | |
97 | ||
98 | (unless (network-reachable?) (test-skip 1)) ;for bootstrap binaries | |
99 | (test-equal (string-append "gnu-build-system unpack phase, " | |
100 | "single file (compression: " | |
101 | (if comp comp "None") ")") | |
102 | "expected text" | |
103 | (let*-values | |
104 | (((name) "test") | |
105 | ((compressed-name) (if ext | |
106 | (string-append name "." ext) | |
107 | name)) | |
108 | ((file hash) (test-file %store compressed-name "expected text"))) | |
109 | (call-with-temporary-directory | |
110 | (lambda (dir) | |
111 | (with-directory-excursion dir | |
112 | (unpack #:source file) | |
113 | (call-with-input-file name get-string-all)))))))) | |
114 | compressors) | |
115 | ||
09448c09 LDB |
116 | \f |
117 | ;;; | |
118 | ;;; Test the sanity-check phase of the Python build system. | |
119 | ;;; | |
120 | ||
121 | (define* (make-python-dummy name #:key (setup-py-extra "") | |
122 | (init-py "") (use-setuptools? #t)) | |
123 | (dummy-package (string-append "python-dummy-" name) | |
124 | (version "0.1") | |
125 | (build-system python-build-system) | |
126 | (arguments | |
127 | `(#:tests? #f | |
128 | #:use-setuptools? ,use-setuptools? | |
129 | #:phases | |
130 | (modify-phases %standard-phases | |
131 | (replace 'unpack | |
132 | (lambda _ | |
133 | (mkdir-p "dummy") | |
134 | (with-output-to-file "dummy/__init__.py" | |
135 | (lambda _ | |
136 | (display ,init-py))) | |
137 | (with-output-to-file "setup.py" | |
138 | (lambda _ | |
139 | (format #t "\ | |
140 | ~a | |
141 | setup( | |
142 | name='dummy-~a', | |
143 | version='0.1', | |
144 | packages=['dummy'], | |
145 | ~a | |
146 | )" | |
147 | (if ,use-setuptools? | |
148 | "from setuptools import setup" | |
149 | "from distutils.core import setup") | |
150 | ,name ,setup-py-extra)))))))))) | |
151 | ||
152 | (define python-dummy-ok | |
153 | (make-python-dummy "ok")) | |
154 | ||
155 | ;; distutil won't install any metadata, so make sure our script does not fail | |
156 | ;; on a otherwise fine package. | |
157 | (define python-dummy-no-setuptools | |
158 | (make-python-dummy | |
159 | "no-setuptools" #:use-setuptools? #f)) | |
160 | ||
161 | (define python-dummy-fail-requirements | |
162 | (make-python-dummy "fail-requirements" | |
163 | #:setup-py-extra "install_requires=['nonexistent'],")) | |
164 | ||
165 | (define python-dummy-fail-import | |
166 | (make-python-dummy "fail-import" #:init-py "import nonexistent")) | |
167 | ||
168 | (define python-dummy-fail-console-script | |
169 | (make-python-dummy "fail-console-script" | |
170 | #:setup-py-extra (string-append "entry_points={'console_scripts': " | |
171 | "['broken = dummy:nonexistent']},"))) | |
172 | ||
173 | (define (check-build-success store p) | |
174 | (unless store (test-skip 1)) | |
175 | (test-assert (string-append "python-build-system: " (package-name p)) | |
176 | (let* ((drv (package-derivation store p))) | |
177 | (build-derivations store (list drv))))) | |
178 | ||
179 | (define (check-build-failure store p) | |
180 | (unless store (test-skip 1)) | |
181 | (test-assert (string-append "python-build-system: " (package-name p)) | |
d8fdd1c7 LC |
182 | (let ((drv (package-derivation store p))) |
183 | (guard (c ((store-protocol-error? c) | |
184 | (pk 'failure c #t))) ;good! | |
185 | (build-derivations store (list drv)) | |
186 | #f)))) ;bad: it should have failed | |
09448c09 LDB |
187 | |
188 | (with-external-store store | |
189 | (for-each (lambda (p) (check-build-success store p)) | |
190 | (list | |
191 | python-dummy-ok | |
192 | python-dummy-no-setuptools)) | |
193 | (for-each (lambda (p) (check-build-failure store p)) | |
194 | (list | |
195 | python-dummy-fail-requirements | |
196 | python-dummy-fail-import | |
197 | python-dummy-fail-console-script))) | |
198 | ||
3eb98237 | 199 | (test-end "builders") |