projects/guix·blob javascript-team · refs

223 lines · 7.9 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2012-2015, 2018-2019, 2021, 2023 Ludovic Courtès <[email protected]>
3;;; Copyright © 2021 Lars-Dominik Braun <[email protected]>
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
21(define-module (tests builders)
22 #:use-module (guix download)
23 #:use-module (guix git-download)
24 #:use-module (guix build-system)
25 #:use-module (guix build-system gnu)
26 #:use-module (guix build gnu-build-system)
27 #:use-module (guix build utils)
28 #:use-module (guix build-system pyproject)
29 #:use-module (guix store)
30 #:use-module (guix monads)
31 #:use-module (guix utils)
32 #:use-module (guix base32)
33 #:use-module (guix derivations)
34 #:use-module (gcrypt hash)
35 #:use-module ((guix hash) #:select (file-hash*))
36 #:use-module (guix tests)
37 #:use-module (guix tests git)
38 #:use-module (guix packages)
39 #:use-module (gnu packages bootstrap)
40 #:use-module (gnu packages python-build)
41 #:use-module ((ice-9 ftw) #:select (scandir))
42 #:use-module (ice-9 match)
43 #:use-module (ice-9 textual-ports)
44 #:use-module (srfi srfi-1)
45 #:use-module (srfi srfi-11)
46 #:use-module (srfi srfi-34)
47 #:use-module (srfi srfi-64))
48
49;; Test the higher-level builders.
50
51(define %store
52 (open-connection-for-tests))
53
54(define url-fetch*
55 (store-lower url-fetch))
56
57;; Globally disable grafts because they can trigger early builds.
58(%graft? #f)
59
60
61(test-begin "builders")
62
63(unless (network-reachable?) (test-skip 1))
64(test-assert "url-fetch"
65 (let* ((url '("http://ftp.gnu.org/gnu/hello/hello-2.8.tar.gz"
66 "ftp://ftp.gnu.org/gnu/hello/hello-2.8.tar.gz"))
67 (hash (nix-base32-string->bytevector
68 "0wqd8sjmxfskrflaxywc7gqw7sfawrfvdxd9skxawzfgyy0pzdz6"))
69 (drv (url-fetch* %store url 'sha256 hash
70 #:guile %bootstrap-guile))
71 (out-path (derivation->output-path drv)))
72 (and (build-derivations %store (list drv))
73 (file-exists? out-path)
74 (valid-path? %store out-path))))
75
76(test-assert "url-fetch, file"
77 (let* ((file (search-path %load-path "guix.scm"))
78 (hash (call-with-input-file file port-sha256))
79 (out (url-fetch* %store file 'sha256 hash)))
80 (and (file-exists? out)
81 (valid-path? %store out))))
82
83(test-assert "url-fetch, file URI"
84 (let* ((file (search-path %load-path "guix.scm"))
85 (hash (call-with-input-file file port-sha256))
86 (out (url-fetch* %store
87 (string-append "file://" (canonicalize-path file))
88 'sha256 hash)))
89 (and (file-exists? out)
90 (valid-path? %store out))))
91
92(test-equal "git-fetch, local URI"
93 '("." ".." "a.txt" "b.scm")
94 (let ((nonce (random-text)))
95 (with-served-temporary-git-repository directory port
96 `((add "a.txt" ,nonce)
97 (add "b.scm" "#t")
98 (commit "Commit.")
99 (tag "v1.0.0" "The tag."))
100 (run-with-store %store
101 (mlet* %store-monad ((hash
102 -> (file-hash* directory
103 #:algorithm (hash-algorithm sha256)
104 #:recursive? #t))
105 (drv (git-fetch
106 (git-reference
107 (url (string-append "git://localhost:"
108 (number->string port)
109 "/"))
110 (commit "v1.0.0"))
111 'sha256 hash
112 "git-fetch-test")))
113 (mbegin %store-monad
114 (built-derivations (list drv))
115 (return (scandir (derivation->output-path drv)))))))))
116
117(test-assert "gnu-build-system"
118 (build-system? gnu-build-system))
119
120(define unpack (assoc-ref %standard-phases 'unpack))
121
122(define compressors '(("gzip" . "gz")
123 ("xz" . "xz")
124 ("bzip2" . "bz2")
125 (#f . #f)))
126
127(for-each
128 (match-lambda
129 ((comp . ext)
130
131 (unless (network-reachable?) (test-skip 1)) ;for bootstrap binaries
132 (test-equal (string-append "gnu-build-system unpack phase, "
133 "single file (compression: "
134 (if comp comp "None") ")")
135 "expected text"
136 (let*-values
137 (((name) "test")
138 ((compressed-name) (if ext
139 (string-append name "." ext)
140 name))
141 ((file hash) (test-file %store compressed-name "expected text")))
142 (call-with-temporary-directory
143 (lambda (dir)
144 (with-directory-excursion dir
145 (unpack #:source file)
146 (sync)
147 (call-with-input-file name get-string-all))))))))
148 compressors)
149
150
151;;;
152;;; Test the sanity-check phase of the Pyproject build system.
153;;;
154
155(define* (make-python-dummy name #:key (setup-py-extra "")
156 (init-py ""))
157 (dummy-package (string-append "python-dummy-" name)
158 (version "0.1")
159 (build-system pyproject-build-system)
160 (arguments
161 `(#:tests? #f
162 #:phases
163 (modify-phases %standard-phases
164 (replace 'unpack
165 (lambda _
166 (mkdir-p "dummy")
167 (with-output-to-file "dummy/__init__.py"
168 (lambda _
169 (display ,init-py)))
170 (with-output-to-file "setup.py"
171 (lambda _
172 (format #t "\
173from setuptools import setup
174setup(
175 name='dummy-~a',
176 version='0.1',
177 packages=['dummy'],
178 ~a
179 )"
180 ,name ,setup-py-extra))))))))
181 (native-inputs (list python-setuptools))))
182
183(define python-dummy-ok
184 (make-python-dummy "ok"))
185
186(define python-dummy-fail-requirements
187 (make-python-dummy "fail-requirements"
188 #:setup-py-extra "install_requires=['nonexistent'],"))
189
190(define python-dummy-fail-import
191 (make-python-dummy "fail-import" #:init-py "import nonexistent"))
192
193(define python-dummy-fail-console-script
194 (make-python-dummy "fail-console-script"
195 #:setup-py-extra (string-append "entry_points={'console_scripts': "
196 "['broken = dummy:nonexistent']},")))
197
198(define (check-build-success store p)
199 (unless store (test-skip 1))
200 (test-assert (string-append "pyproject-build-system: " (package-name p))
201 (let* ((drv (package-derivation store p)))
202 (build-derivations store (list drv)))))
203
204(define (check-build-failure store p)
205 (unless store (test-skip 1))
206 (test-assert (string-append "pyproject-build-system: " (package-name p))
207 (let ((drv (package-derivation store p)))
208 (guard (c ((store-protocol-error? c)
209 (pk 'failure c #t))) ;good!
210 (build-derivations store (list drv))
211 #f)))) ;bad: it should have failed
212
213(with-external-store store
214 (for-each (lambda (p) (check-build-success store p))
215 (list
216 python-dummy-ok))
217 (for-each (lambda (p) (check-build-failure store p))
218 (list
219 python-dummy-fail-requirements
220 python-dummy-fail-import
221 python-dummy-fail-console-script)))
222
223(test-end "builders")