You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

1108 lines
53 KiB

  1. ;;; GNU Guix --- Functional package management for GNU
  2. ;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
  3. ;;;
  4. ;;; This file is part of GNU Guix.
  5. ;;;
  6. ;;; GNU Guix is free software; you can redistribute it and/or modify it
  7. ;;; under the terms of the GNU General Public License as published by
  8. ;;; the Free Software Foundation; either version 3 of the License, or (at
  9. ;;; your option) any later version.
  10. ;;;
  11. ;;; GNU Guix is distributed in the hope that it will be useful, but
  12. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14. ;;; GNU General Public License for more details.
  15. ;;;
  16. ;;; You should have received a copy of the GNU General Public License
  17. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
  18. (unsetenv "http_proxy")
  19. (define-module (test-derivations)
  20. #:use-module (guix derivations)
  21. #:use-module (guix grafts)
  22. #:use-module (guix store)
  23. #:use-module (guix utils)
  24. #:use-module (guix hash)
  25. #:use-module (guix base32)
  26. #:use-module (guix tests)
  27. #:use-module (guix tests http)
  28. #:use-module ((guix packages) #:select (package-derivation base32))
  29. #:use-module ((guix build utils) #:select (executable-file?))
  30. #:use-module ((gnu packages) #:select (search-bootstrap-binary))
  31. #:use-module (gnu packages bootstrap)
  32. #:use-module ((gnu packages guile) #:select (guile-1.8))
  33. #:use-module (srfi srfi-1)
  34. #:use-module (srfi srfi-11)
  35. #:use-module (srfi srfi-26)
  36. #:use-module (srfi srfi-34)
  37. #:use-module (srfi srfi-64)
  38. #:use-module (rnrs io ports)
  39. #:use-module (rnrs bytevectors)
  40. #:use-module (web uri)
  41. #:use-module (ice-9 rdelim)
  42. #:use-module (ice-9 regex)
  43. #:use-module (ice-9 ftw)
  44. #:use-module (ice-9 match))
  45. (define %store
  46. (open-connection-for-tests))
  47. ;; Globally disable grafts because they can trigger early builds.
  48. (%graft? #f)
  49. (define (bootstrap-binary name)
  50. (let ((bin (search-bootstrap-binary name (%current-system))))
  51. (and %store
  52. (add-to-store %store name #t "sha256" bin))))
  53. (define %bash
  54. (bootstrap-binary "bash"))
  55. (define %mkdir
  56. (bootstrap-binary "mkdir"))
  57. (define* (directory-contents dir #:optional (slurp get-bytevector-all))
  58. "Return an alist representing the contents of DIR."
  59. (define prefix-len (string-length dir))
  60. (sort (file-system-fold (const #t) ; enter?
  61. (lambda (path stat result) ; leaf
  62. (alist-cons (string-drop path prefix-len)
  63. (call-with-input-file path slurp)
  64. result))
  65. (lambda (path stat result) result) ; down
  66. (lambda (path stat result) result) ; up
  67. (lambda (path stat result) result) ; skip
  68. (lambda (path stat errno result) result) ; error
  69. '()
  70. dir)
  71. (lambda (e1 e2)
  72. (string<? (car e1) (car e2)))))
  73. ;; Avoid collisions with other tests.
  74. (%http-server-port 10500)
  75. (test-begin "derivations")
  76. (test-assert "parse & export"
  77. (let* ((f (search-path %load-path "tests/test.drv"))
  78. (b1 (call-with-input-file f get-bytevector-all))
  79. (d1 (read-derivation (open-bytevector-input-port b1)))
  80. (b2 (call-with-bytevector-output-port (cut write-derivation d1 <>)))
  81. (d2 (read-derivation (open-bytevector-input-port b2))))
  82. (and (equal? b1 b2)
  83. (equal? d1 d2))))
  84. (test-skip (if %store 0 12))
  85. (test-assert "add-to-store, flat"
  86. (let* ((file (search-path %load-path "language/tree-il/spec.scm"))
  87. (drv (add-to-store %store "flat-test" #f "sha256" file)))
  88. (and (eq? 'regular (stat:type (stat drv)))
  89. (valid-path? %store drv)
  90. (equal? (call-with-input-file file get-bytevector-all)
  91. (call-with-input-file drv get-bytevector-all)))))
  92. (test-assert "add-to-store, recursive"
  93. (let* ((dir (dirname (search-path %load-path "language/tree-il/spec.scm")))
  94. (drv (add-to-store %store "dir-tree-test" #t "sha256" dir)))
  95. (and (eq? 'directory (stat:type (stat drv)))
  96. (valid-path? %store drv)
  97. (equal? (directory-contents dir)
  98. (directory-contents drv)))))
  99. (test-assert "derivation with no inputs"
  100. (let* ((builder (add-text-to-store %store "my-builder.sh"
  101. "echo hello, world\n"
  102. '()))
  103. (drv (derivation %store "foo"
  104. %bash `("-e" ,builder)
  105. #:env-vars '(("HOME" . "/homeless")))))
  106. (and (store-path? (derivation-file-name drv))
  107. (valid-path? %store (derivation-file-name drv)))))
  108. (test-assert "build derivation with 1 source"
  109. (let* ((builder (add-text-to-store %store "my-builder.sh"
  110. "echo hello, world > \"$out\"\n"
  111. '()))
  112. (drv (derivation %store "foo"
  113. %bash `(,builder)
  114. #:env-vars '(("HOME" . "/homeless")
  115. ("zzz" . "Z!")
  116. ("AAA" . "A!"))
  117. #:inputs `((,%bash) (,builder))))
  118. (succeeded?
  119. (build-derivations %store (list drv))))
  120. (and succeeded?
  121. (let ((path (derivation->output-path drv)))
  122. (and (valid-path? %store path)
  123. (string=? (call-with-input-file path read-line)
  124. "hello, world"))))))
  125. (test-assert "derivation with local file as input"
  126. (let* ((builder (add-text-to-store
  127. %store "my-builder.sh"
  128. "(while read line ; do echo \"$line\" ; done) < $in > $out"
  129. '()))
  130. (input (search-path %load-path "ice-9/boot-9.scm"))
  131. (input* (add-to-store %store (basename input)
  132. #t "sha256" input))
  133. (drv (derivation %store "derivation-with-input-file"
  134. %bash `(,builder)
  135. ;; Cheat to pass the actual file name to the
  136. ;; builder.
  137. #:env-vars `(("in" . ,input*))
  138. #:inputs `((,%bash)
  139. (,builder)
  140. (,input))))) ; ← local file name
  141. (and (build-derivations %store (list drv))
  142. ;; Note: we can't compare the files because the above trick alters
  143. ;; the contents.
  144. (valid-path? %store (derivation->output-path drv)))))
  145. (test-assert "derivation fails but keep going"
  146. ;; In keep-going mode, 'build-derivations' should fail because of D1, but it
  147. ;; must return only after D2 has succeeded.
  148. (with-store store
  149. (let* ((d1 (derivation %store "fails"
  150. %bash `("-c" "false")
  151. #:inputs `((,%bash))))
  152. (d2 (build-expression->derivation %store "sleep-then-succeed"
  153. `(begin
  154. ,(random-text)
  155. ;; XXX: Hopefully that's long
  156. ;; enough that D1 has already
  157. ;; failed.
  158. (sleep 2)
  159. (mkdir %output)))))
  160. (set-build-options %store
  161. #:use-substitutes? #f
  162. #:keep-going? #t)
  163. (guard (c ((nix-protocol-error? c)
  164. (and (= 100 (nix-protocol-error-status c))
  165. (string-contains (nix-protocol-error-message c)
  166. (derivation-file-name d1))
  167. (not (valid-path? %store (derivation->output-path d1)))
  168. (valid-path? %store (derivation->output-path d2)))))
  169. (build-derivations %store (list d1 d2))
  170. #f))))
  171. (test-assert "identical files are deduplicated"
  172. (let* ((build1 (add-text-to-store %store "one.sh"
  173. "echo hello, world > \"$out\"\n"
  174. '()))
  175. (build2 (add-text-to-store %store "two.sh"
  176. "# Hey!\necho hello, world > \"$out\"\n"
  177. '()))
  178. (drv1 (derivation %store "foo"
  179. %bash `(,build1)
  180. #:inputs `((,%bash) (,build1))))
  181. (drv2 (derivation %store "bar"
  182. %bash `(,build2)
  183. #:inputs `((,%bash) (,build2)))))
  184. (and (build-derivations %store (list drv1 drv2))
  185. (let ((file1 (derivation->output-path drv1))
  186. (file2 (derivation->output-path drv2)))
  187. (and (valid-path? %store file1) (valid-path? %store file2)
  188. (string=? (call-with-input-file file1 get-string-all)
  189. "hello, world\n")
  190. (= (stat:ino (lstat file1))
  191. (stat:ino (lstat file2))))))))
  192. (test-assert "unknown built-in builder"
  193. (let ((drv (derivation %store "ohoh" "builtin:does-not-exist" '())))
  194. (guard (c ((nix-protocol-error? c)
  195. (string-contains (nix-protocol-error-message c) "failed")))
  196. (build-derivations %store (list drv))
  197. #f)))
  198. (unless (force %http-server-socket)
  199. (test-skip 1))
  200. (test-assert "'download' built-in builder"
  201. (let ((text (random-text)))
  202. (with-http-server 200 text
  203. (let* ((drv (derivation %store "world"
  204. "builtin:download" '()
  205. #:env-vars `(("url"
  206. . ,(object->string (%local-url))))
  207. #:hash-algo 'sha256
  208. #:hash (sha256 (string->utf8 text)))))
  209. (and (build-derivations %store (list drv))
  210. (string=? (call-with-input-file (derivation->output-path drv)
  211. get-string-all)
  212. text))))))
  213. (unless (force %http-server-socket)
  214. (test-skip 1))
  215. (test-assert "'download' built-in builder, invalid hash"
  216. (with-http-server 200 "hello, world!"
  217. (let* ((drv (derivation %store "world"
  218. "builtin:download" '()
  219. #:env-vars `(("url"
  220. . ,(object->string (%local-url))))
  221. #:hash-algo 'sha256
  222. #:hash (sha256 (random-bytevector 100))))) ;wrong
  223. (guard (c ((nix-protocol-error? c)
  224. (string-contains (nix-protocol-error-message c) "failed")))
  225. (build-derivations %store (list drv))
  226. #f))))
  227. (unless (force %http-server-socket)
  228. (test-skip 1))
  229. (test-assert "'download' built-in builder, not found"
  230. (with-http-server 404 "not found"
  231. (let* ((drv (derivation %store "will-never-be-found"
  232. "builtin:download" '()
  233. #:env-vars `(("url"
  234. . ,(object->string (%local-url))))
  235. #:hash-algo 'sha256
  236. #:hash (sha256 (random-bytevector 100)))))
  237. (guard (c ((nix-protocol-error? c)
  238. (string-contains (nix-protocol-error-message (pk c)) "failed")))
  239. (build-derivations %store (list drv))
  240. #f))))
  241. (test-assert "'download' built-in builder, not fixed-output"
  242. (let* ((source (add-text-to-store %store "hello" "hi!"))
  243. (url (string-append "file://" source))
  244. (drv (derivation %store "world"
  245. "builtin:download" '()
  246. #:env-vars `(("url" . ,(object->string url))))))
  247. (guard (c ((nix-protocol-error? c)
  248. (string-contains (nix-protocol-error-message c) "failed")))
  249. (build-derivations %store (list drv))
  250. #f)))
  251. (test-equal "derivation-name"
  252. "foo-0.0"
  253. (let ((drv (derivation %store "foo-0.0" %bash '())))
  254. (derivation-name drv)))
  255. (test-equal "derivation-output-names"
  256. '(("out") ("bar" "chbouib"))
  257. (let ((drv1 (derivation %store "foo-0.0" %bash '()))
  258. (drv2 (derivation %store "foo-0.0" %bash '()
  259. #:outputs '("bar" "chbouib"))))
  260. (list (derivation-output-names drv1)
  261. (derivation-output-names drv2))))
  262. (test-assert "offloadable-derivation?"
  263. (and (offloadable-derivation? (derivation %store "foo" %bash '()))
  264. (offloadable-derivation? ;see <http://bugs.gnu.org/18747>
  265. (derivation %store "foo" %bash '()
  266. #:substitutable? #f))
  267. (not (offloadable-derivation?
  268. (derivation %store "foo" %bash '()
  269. #:local-build? #t)))))
  270. (test-assert "substitutable-derivation?"
  271. (and (substitutable-derivation? (derivation %store "foo" %bash '()))
  272. (substitutable-derivation? ;see <http://bugs.gnu.org/18747>
  273. (derivation %store "foo" %bash '()
  274. #:local-build? #t))
  275. (not (substitutable-derivation?
  276. (derivation %store "foo" %bash '()
  277. #:substitutable? #f)))))
  278. (test-assert "fixed-output-derivation?"
  279. (let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
  280. "echo -n hello > $out" '()))
  281. (hash (sha256 (string->utf8 "hello")))
  282. (drv (derivation %store "fixed"
  283. %bash `(,builder)
  284. #:inputs `((,builder))
  285. #:hash hash #:hash-algo 'sha256)))
  286. (fixed-output-derivation? drv)))
  287. (test-assert "fixed-output derivation"
  288. (let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
  289. "echo -n hello > $out" '()))
  290. (hash (sha256 (string->utf8 "hello")))
  291. (drv (derivation %store "fixed"
  292. %bash `(,builder)
  293. #:inputs `((,builder)) ; optional
  294. #:hash hash #:hash-algo 'sha256))
  295. (succeeded? (build-derivations %store (list drv))))
  296. (and succeeded?
  297. (let ((p (derivation->output-path drv)))
  298. (and (equal? (string->utf8 "hello")
  299. (call-with-input-file p get-bytevector-all))
  300. (bytevector? (query-path-hash %store p)))))))
  301. (test-assert "fixed-output derivation: output paths are equal"
  302. (let* ((builder1 (add-text-to-store %store "fixed-builder1.sh"
  303. "echo -n hello > $out" '()))
  304. (builder2 (add-text-to-store %store "fixed-builder2.sh"
  305. "echo hey; echo -n hello > $out" '()))
  306. (hash (sha256 (string->utf8 "hello")))
  307. (drv1 (derivation %store "fixed"
  308. %bash `(,builder1)
  309. #:hash hash #:hash-algo 'sha256))
  310. (drv2 (derivation %store "fixed"
  311. %bash `(,builder2)
  312. #:hash hash #:hash-algo 'sha256))
  313. (succeeded? (build-derivations %store (list drv1 drv2))))
  314. (and succeeded?
  315. (equal? (derivation->output-path drv1)
  316. (derivation->output-path drv2)))))
  317. (test-assert "fixed-output derivation, recursive"
  318. (let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
  319. "echo -n hello > $out" '()))
  320. (hash (sha256 (string->utf8 "hello")))
  321. (drv (derivation %store "fixed-rec"
  322. %bash `(,builder)
  323. #:inputs `((,builder))
  324. #:hash (base32 "0sg9f58l1jj88w6pdrfdpj5x9b1zrwszk84j81zvby36q9whhhqa")
  325. #:hash-algo 'sha256
  326. #:recursive? #t))
  327. (succeeded? (build-derivations %store (list drv))))
  328. (and succeeded?
  329. (let ((p (derivation->output-path drv)))
  330. (and (equal? (string->utf8 "hello")
  331. (call-with-input-file p get-bytevector-all))
  332. (bytevector? (query-path-hash %store p)))))))
  333. (test-assert "derivation with a fixed-output input"
  334. ;; A derivation D using a fixed-output derivation F doesn't has the same
  335. ;; output path when passed F or F', as long as F and F' have the same output
  336. ;; path.
  337. (let* ((builder1 (add-text-to-store %store "fixed-builder1.sh"
  338. "echo -n hello > $out" '()))
  339. (builder2 (add-text-to-store %store "fixed-builder2.sh"
  340. "echo hey; echo -n hello > $out" '()))
  341. (hash (sha256 (string->utf8 "hello")))
  342. (fixed1 (derivation %store "fixed"
  343. %bash `(,builder1)
  344. #:hash hash #:hash-algo 'sha256))
  345. (fixed2 (derivation %store "fixed"
  346. %bash `(,builder2)
  347. #:hash hash #:hash-algo 'sha256))
  348. (fixed-out (derivation->output-path fixed1))
  349. (builder3 (add-text-to-store
  350. %store "final-builder.sh"
  351. ;; Use Bash hackery to avoid Coreutils.
  352. "echo $in ; (read -u 3 c; echo $c) 3< $in > $out" '()))
  353. (final1 (derivation %store "final"
  354. %bash `(,builder3)
  355. #:env-vars `(("in" . ,fixed-out))
  356. #:inputs `((,%bash) (,builder3) (,fixed1))))
  357. (final2 (derivation %store "final"
  358. %bash `(,builder3)
  359. #:env-vars `(("in" . ,fixed-out))
  360. #:inputs `((,%bash) (,builder3) (,fixed2))))
  361. (succeeded? (build-derivations %store
  362. (list final1 final2))))
  363. (and succeeded?
  364. (equal? (derivation->output-path final1)
  365. (derivation->output-path final2)))))
  366. (test-assert "multiple-output derivation"
  367. (let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
  368. "echo one > $out ; echo two > $second"
  369. '()))
  370. (drv (derivation %store "fixed"
  371. %bash `(,builder)
  372. #:env-vars '(("HOME" . "/homeless")
  373. ("zzz" . "Z!")
  374. ("AAA" . "A!"))
  375. #:inputs `((,%bash) (,builder))
  376. #:outputs '("out" "second")))
  377. (succeeded? (build-derivations %store (list drv))))
  378. (and succeeded?
  379. (let ((one (derivation->output-path drv "out"))
  380. (two (derivation->output-path drv "second")))
  381. (and (lset= equal?
  382. (derivation->output-paths drv)
  383. `(("out" . ,one) ("second" . ,two)))
  384. (eq? 'one (call-with-input-file one read))
  385. (eq? 'two (call-with-input-file two read)))))))
  386. (test-assert "multiple-output derivation, non-alphabetic order"
  387. ;; Here, the outputs are not listed in alphabetic order. Yet, the store
  388. ;; path computation must reorder them first.
  389. (let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
  390. "echo one > $out ; echo two > $AAA"
  391. '()))
  392. (drv (derivation %store "fixed"
  393. %bash `(,builder)
  394. #:inputs `((,%bash) (,builder))
  395. #:outputs '("out" "AAA")))
  396. (succeeded? (build-derivations %store (list drv))))
  397. (and succeeded?
  398. (let ((one (derivation->output-path drv "out"))
  399. (two (derivation->output-path drv "AAA")))
  400. (and (eq? 'one (call-with-input-file one read))
  401. (eq? 'two (call-with-input-file two read)))))))
  402. (test-assert "read-derivation vs. derivation"
  403. ;; Make sure 'derivation' and 'read-derivation' return objects that are
  404. ;; identical.
  405. (let* ((sources (unfold (cut >= <> 10)
  406. (lambda (n)
  407. (add-text-to-store %store
  408. (format #f "input~a" n)
  409. (random-text)))
  410. 1+
  411. 0))
  412. (inputs (map (lambda (file)
  413. (derivation %store "derivation-input"
  414. %bash '()
  415. #:inputs `((,%bash) (,file))))
  416. sources))
  417. (builder (add-text-to-store %store "builder.sh"
  418. "echo one > $one ; echo two > $two"
  419. '()))
  420. (drv (derivation %store "derivation"
  421. %bash `(,builder)
  422. #:inputs `((,%bash) (,builder)
  423. ,@(map list (append sources inputs)))
  424. #:outputs '("two" "one")))
  425. (drv* (call-with-input-file (derivation-file-name drv)
  426. read-derivation)))
  427. (equal? drv* drv)))
  428. (test-assert "multiple-output derivation, derivation-path->output-path"
  429. (let* ((builder (add-text-to-store %store "builder.sh"
  430. "echo one > $out ; echo two > $second"
  431. '()))
  432. (drv (derivation %store "multiple"
  433. %bash `(,builder)
  434. #:outputs '("out" "second")))
  435. (drv-file (derivation-file-name drv))
  436. (one (derivation->output-path drv "out"))
  437. (two (derivation->output-path drv "second"))
  438. (first (derivation-path->output-path drv-file "out"))
  439. (second (derivation-path->output-path drv-file "second")))
  440. (and (not (string=? one two))
  441. (string-suffix? "-second" two)
  442. (string=? first one)
  443. (string=? second two))))
  444. (test-assert "user of multiple-output derivation"
  445. ;; Check whether specifying several inputs coming from the same
  446. ;; multiple-output derivation works.
  447. (let* ((builder1 (add-text-to-store %store "my-mo-builder.sh"
  448. "echo one > $out ; echo two > $two"
  449. '()))
  450. (mdrv (derivation %store "multiple-output"
  451. %bash `(,builder1)
  452. #:inputs `((,%bash) (,builder1))
  453. #:outputs '("out" "two")))
  454. (builder2 (add-text-to-store %store "my-mo-user-builder.sh"
  455. "read x < $one;
  456. read y < $two;
  457. echo \"($x $y)\" > $out"
  458. '()))
  459. (udrv (derivation %store "multiple-output-user"
  460. %bash `(,builder2)
  461. #:env-vars `(("one"
  462. . ,(derivation->output-path
  463. mdrv "out"))
  464. ("two"
  465. . ,(derivation->output-path
  466. mdrv "two")))
  467. #:inputs `((,%bash)
  468. (,builder2)
  469. ;; two occurrences of MDRV:
  470. (,mdrv)
  471. (,mdrv "two")))))
  472. (and (build-derivations %store (list (pk 'udrv udrv)))
  473. (let ((p (derivation->output-path udrv)))
  474. (and (valid-path? %store p)
  475. (equal? '(one two) (call-with-input-file p read)))))))
  476. (test-assert "derivation with #:references-graphs"
  477. (let* ((input1 (add-text-to-store %store "foo" "hello"
  478. (list %bash)))
  479. (input2 (add-text-to-store %store "bar"
  480. (number->string (random 7777))
  481. (list input1)))
  482. (builder (add-text-to-store %store "build-graph"
  483. (format #f "
  484. ~a $out
  485. (while read l ; do echo $l ; done) < bash > $out/bash
  486. (while read l ; do echo $l ; done) < input1 > $out/input1
  487. (while read l ; do echo $l ; done) < input2 > $out/input2"
  488. %mkdir)
  489. (list %mkdir)))
  490. (drv (derivation %store "closure-graphs"
  491. %bash `(,builder)
  492. #:references-graphs
  493. `(("bash" . ,%bash)
  494. ("input1" . ,input1)
  495. ("input2" . ,input2))
  496. #:inputs `((,%bash) (,builder))))
  497. (out (derivation->output-path drv)))
  498. (define (deps path . deps)
  499. (let ((count (length deps)))
  500. (string-append path "\n\n" (number->string count) "\n"
  501. (string-join (sort deps string<?) "\n")
  502. (if (zero? count) "" "\n"))))
  503. (and (build-derivations %store (list drv))
  504. (equal? (directory-contents out get-string-all)
  505. `(("/bash" . ,(string-append %bash "\n\n0\n"))
  506. ("/input1" . ,(if (string>? input1 %bash)
  507. (string-append (deps %bash)
  508. (deps input1 %bash))
  509. (string-append (deps input1 %bash)
  510. (deps %bash))))
  511. ("/input2" . ,(string-concatenate
  512. (map cdr
  513. (sort
  514. (map (lambda (p d)
  515. (cons p (apply deps p d)))
  516. (list %bash input1 input2)
  517. (list '() (list %bash) (list input1)))
  518. (lambda (x y)
  519. (match x
  520. ((p1 . _)
  521. (match y
  522. ((p2 . _)
  523. (string<? p1 p2)))))))))))))))
  524. (test-assert "derivation #:allowed-references, ok"
  525. (let ((drv (derivation %store "allowed" %bash
  526. '("-c" "echo hello > $out")
  527. #:inputs `((,%bash))
  528. #:allowed-references '())))
  529. (build-derivations %store (list drv))))
  530. (test-assert "derivation #:allowed-references, not allowed"
  531. (let* ((txt (add-text-to-store %store "foo" "Hello, world."))
  532. (drv (derivation %store "disallowed" %bash
  533. `("-c" ,(string-append "echo " txt "> $out"))
  534. #:inputs `((,%bash) (,txt))
  535. #:allowed-references '())))
  536. (guard (c ((nix-protocol-error? c)
  537. ;; There's no specific error message to check for.
  538. #t))
  539. (build-derivations %store (list drv))
  540. #f)))
  541. (test-assert "derivation #:allowed-references, self allowed"
  542. (let ((drv (derivation %store "allowed" %bash
  543. '("-c" "echo $out > $out")
  544. #:inputs `((,%bash))
  545. #:allowed-references '("out"))))
  546. (build-derivations %store (list drv))))
  547. (test-assert "derivation #:allowed-references, self not allowed"
  548. (let ((drv (derivation %store "disallowed" %bash
  549. `("-c" ,"echo $out > $out")
  550. #:inputs `((,%bash))
  551. #:allowed-references '())))
  552. (guard (c ((nix-protocol-error? c)
  553. ;; There's no specific error message to check for.
  554. #t))
  555. (build-derivations %store (list drv))
  556. #f)))
  557. (test-assert "derivation #:disallowed-references, ok"
  558. (let ((drv (derivation %store "disallowed" %bash
  559. '("-c" "echo hello > $out")
  560. #:inputs `((,%bash))
  561. #:disallowed-references '("out"))))
  562. (build-derivations %store (list drv))))
  563. (test-assert "derivation #:disallowed-references, not ok"
  564. (let* ((txt (add-text-to-store %store "foo" "Hello, world."))
  565. (drv (derivation %store "disdisallowed" %bash
  566. `("-c" ,(string-append "echo " txt "> $out"))
  567. #:inputs `((,%bash) (,txt))
  568. #:disallowed-references (list txt))))
  569. (guard (c ((nix-protocol-error? c)
  570. ;; There's no specific error message to check for.
  571. #t))
  572. (build-derivations %store (list drv))
  573. #f)))
  574. ;; Here we should get the value of $NIX_STATE_DIR that the daemon sees, which
  575. ;; is a unique value for each test process; this value is the same as the one
  576. ;; we see in the process executing this file since it is set by 'test-env'.
  577. (test-equal "derivation #:leaked-env-vars"
  578. (getenv "NIX_STATE_DIR")
  579. (let* ((value (getenv "NIX_STATE_DIR"))
  580. (drv (derivation %store "leaked-env-vars" %bash
  581. '("-c" "echo -n $NIX_STATE_DIR > $out")
  582. #:hash (sha256 (string->utf8 value))
  583. #:hash-algo 'sha256
  584. #:inputs `((,%bash))
  585. #:leaked-env-vars '("NIX_STATE_DIR"))))
  586. (and (build-derivations %store (list drv))
  587. (call-with-input-file (derivation->output-path drv)
  588. get-string-all))))
  589. (define %coreutils
  590. (false-if-exception
  591. (and (network-reachable?)
  592. (package-derivation %store %bootstrap-coreutils&co))))
  593. (test-skip (if %coreutils 0 1))
  594. (test-assert "build derivation with coreutils"
  595. (let* ((builder
  596. (add-text-to-store %store "build-with-coreutils.sh"
  597. "echo $PATH ; mkdir --version ; mkdir $out ; touch $out/good"
  598. '()))
  599. (drv
  600. (derivation %store "foo"
  601. %bash `(,builder)
  602. #:env-vars `(("PATH" .
  603. ,(string-append
  604. (derivation->output-path %coreutils)
  605. "/bin")))
  606. #:inputs `((,builder)
  607. (,%coreutils))))
  608. (succeeded?
  609. (build-derivations %store (list drv))))
  610. (and succeeded?
  611. (let ((p (derivation->output-path drv)))
  612. (and (valid-path? %store p)
  613. (file-exists? (string-append p "/good")))))))
  614. (test-skip (if (%guile-for-build) 0 8))
  615. (test-equal "build-expression->derivation and invalid module name"
  616. '(file-search-error "guix/module/that/does/not/exist.scm")
  617. (guard (c ((file-search-error? c)
  618. (list 'file-search-error
  619. (file-search-error-file-name c))))
  620. (build-expression->derivation %store "foo" #t
  621. #:modules '((guix module that
  622. does not exist)))))
  623. (test-assert "build-expression->derivation and derivation-prerequisites"
  624. (let ((drv (build-expression->derivation %store "fail" #f)))
  625. (any (match-lambda
  626. (($ <derivation-input> path)
  627. (string=? path (derivation-file-name (%guile-for-build)))))
  628. (derivation-prerequisites drv))))
  629. (test-assert "derivation-prerequisites and valid-derivation-input?"
  630. (let* ((a (build-expression->derivation %store "a" '(mkdir %output)))
  631. (b (build-expression->derivation %store "b" `(list ,(random-text))))
  632. (c (build-expression->derivation %store "c" `(mkdir %output)
  633. #:inputs `(("a" ,a) ("b" ,b)))))
  634. ;; Make sure both A and %BOOTSTRAP-GUILE are built (the latter could have
  635. ;; be removed by tests/guix-gc.sh.)
  636. (build-derivations %store
  637. (list a (package-derivation %store %bootstrap-guile)))
  638. (match (derivation-prerequisites c
  639. (cut valid-derivation-input? %store
  640. <>))
  641. ((($ <derivation-input> file ("out")))
  642. (string=? file (derivation-file-name b)))
  643. (x
  644. (pk 'fail x #f)))))
  645. (test-assert "build-expression->derivation without inputs"
  646. (let* ((builder '(begin
  647. (mkdir %output)
  648. (call-with-output-file (string-append %output "/test")
  649. (lambda (p)
  650. (display '(hello guix) p)))))
  651. (drv (build-expression->derivation %store "goo" builder))
  652. (succeeded? (build-derivations %store (list drv))))
  653. (and succeeded?
  654. (let ((p (derivation->output-path drv)))
  655. (equal? '(hello guix)
  656. (call-with-input-file (string-append p "/test") read))))))
  657. (test-assert "build-expression->derivation and max-silent-time"
  658. (let* ((store (let ((s (open-connection)))
  659. (set-build-options s #:max-silent-time 1)
  660. s))
  661. (builder '(begin (sleep 100) (mkdir %output) #t))
  662. (drv (build-expression->derivation store "silent" builder))
  663. (out-path (derivation->output-path drv)))
  664. (guard (c ((nix-protocol-error? c)
  665. (and (string-contains (nix-protocol-error-message c)
  666. "failed")
  667. (not (valid-path? store out-path)))))
  668. (build-derivations store (list drv))
  669. #f)))
  670. (test-assert "build-expression->derivation and timeout"
  671. (let* ((store (let ((s (open-connection)))
  672. (set-build-options s #:timeout 1)
  673. s))
  674. (builder '(begin (sleep 100) (mkdir %output) #t))
  675. (drv (build-expression->derivation store "slow" builder))
  676. (out-path (derivation->output-path drv)))
  677. (guard (c ((nix-protocol-error? c)
  678. (and (string-contains (nix-protocol-error-message c)
  679. "failed")
  680. (not (valid-path? store out-path)))))
  681. (build-derivations store (list drv))
  682. #f)))
  683. (test-assert "build-expression->derivation and derivation-prerequisites-to-build"
  684. (let ((drv (build-expression->derivation %store "fail" #f)))
  685. ;; The only direct dependency is (%guile-for-build) and it's already
  686. ;; built.
  687. (null? (derivation-prerequisites-to-build %store drv))))
  688. (test-assert "derivation-prerequisites-to-build when outputs already present"
  689. (let* ((builder '(begin (mkdir %output) #t))
  690. (input-drv (build-expression->derivation %store "input" builder))
  691. (input-path (derivation-output-path
  692. (assoc-ref (derivation-outputs input-drv)
  693. "out")))
  694. (drv (build-expression->derivation %store "something" builder
  695. #:inputs
  696. `(("i" ,input-drv))))
  697. (output (derivation->output-path drv)))
  698. ;; Make sure these things are not already built.
  699. (when (valid-path? %store input-path)
  700. (delete-paths %store (list input-path)))
  701. (when (valid-path? %store output)
  702. (delete-paths %store (list output)))
  703. (and (equal? (map derivation-input-path
  704. (derivation-prerequisites-to-build %store drv))
  705. (list (derivation-file-name input-drv)))
  706. ;; Build DRV and delete its input.
  707. (build-derivations %store (list drv))
  708. (delete-paths %store (list input-path))
  709. (not (valid-path? %store input-path))
  710. ;; Now INPUT-PATH is missing, yet it shouldn't be listed as a
  711. ;; prerequisite to build because DRV itself is already built.
  712. (null? (derivation-prerequisites-to-build %store drv)))))
  713. (test-assert "derivation-prerequisites-to-build and substitutes"
  714. (let* ((store (open-connection))
  715. (drv (build-expression->derivation store "prereq-subst"
  716. (random 1000)))
  717. (output (derivation->output-path drv)))
  718. ;; Make sure substitutes are usable.
  719. (set-build-options store #:use-substitutes? #t
  720. #:substitute-urls (%test-substitute-urls))
  721. (with-derivation-narinfo drv
  722. (let-values (((build download)
  723. (derivation-prerequisites-to-build store drv))
  724. ((build* download*)
  725. (derivation-prerequisites-to-build store drv
  726. #:substitutable?
  727. (const #f))))
  728. (and (null? build)
  729. (equal? download (list output))
  730. (null? download*)
  731. (null? build*))))))
  732. (test-assert "derivation-prerequisites-to-build and substitutes, non-substitutable build"
  733. (let* ((store (open-connection))
  734. (drv (build-expression->derivation store "prereq-no-subst"
  735. (random 1000)
  736. #:substitutable? #f))
  737. (output (derivation->output-path drv)))
  738. ;; Make sure substitutes are usable.
  739. (set-build-options store #:use-substitutes? #t
  740. #:substitute-urls (%test-substitute-urls))
  741. (with-derivation-narinfo drv
  742. (let-values (((build download)
  743. (derivation-prerequisites-to-build store drv)))
  744. ;; Despite being available as a substitute, DRV will be built locally
  745. ;; due to #:substitutable? #f.
  746. (and (null? download)
  747. (match build
  748. (((? derivation-input? input))
  749. (string=? (derivation-input-path input)
  750. (derivation-file-name drv)))))))))
  751. (test-assert "derivation-prerequisites-to-build and substitutes, local build"
  752. (with-store store
  753. (let* ((drv (build-expression->derivation store "prereq-subst-local"
  754. (random 1000)
  755. #:local-build? #t))
  756. (output (derivation->output-path drv)))
  757. ;; Make sure substitutes are usable.
  758. (set-build-options store #:use-substitutes? #t
  759. #:substitute-urls (%test-substitute-urls))
  760. (with-derivation-narinfo drv
  761. (let-values (((build download)
  762. (derivation-prerequisites-to-build store drv)))
  763. ;; #:local-build? is *not* synonymous with #:substitutable?, so we
  764. ;; must be able to substitute DRV's output.
  765. ;; See <http://bugs.gnu.org/18747>.
  766. (and (null? build)
  767. (match download
  768. (((? string? item))
  769. (string=? item (derivation->output-path drv))))))))))
  770. (test-assert "derivation-prerequisites-to-build in 'check' mode"
  771. (with-store store
  772. (let* ((dep (build-expression->derivation store "dep"
  773. `(begin ,(random-text)
  774. (mkdir %output))))
  775. (drv (build-expression->derivation store "to-check"
  776. '(mkdir %output)
  777. #:inputs `(("dep" ,dep)))))
  778. (build-derivations store (list drv))
  779. (delete-paths store (list (derivation->output-path dep)))
  780. ;; In 'check' mode, DEP must be rebuilt.
  781. (and (null? (derivation-prerequisites-to-build store drv))
  782. (match (derivation-prerequisites-to-build store drv
  783. #:mode (build-mode
  784. check))
  785. ((input)
  786. (string=? (derivation-input-path input)
  787. (derivation-file-name dep))))))))
  788. (test-assert "build-expression->derivation with expression returning #f"
  789. (let* ((builder '(begin
  790. (mkdir %output)
  791. #f)) ; fail!
  792. (drv (build-expression->derivation %store "fail" builder))
  793. (out-path (derivation->output-path drv)))
  794. (guard (c ((nix-protocol-error? c)
  795. ;; Note that the output path may exist at this point, but it
  796. ;; is invalid.
  797. (and (string-match "build .* failed"
  798. (nix-protocol-error-message c))
  799. (not (valid-path? %store out-path)))))
  800. (build-derivations %store (list drv))
  801. #f)))
  802. (test-assert "build-expression->derivation with two outputs"
  803. (let* ((builder '(begin
  804. (call-with-output-file (assoc-ref %outputs "out")
  805. (lambda (p)
  806. (display '(hello) p)))
  807. (call-with-output-file (assoc-ref %outputs "second")
  808. (lambda (p)
  809. (display '(world) p)))))
  810. (drv (build-expression->derivation %store "double" builder
  811. #:outputs '("out"
  812. "second")))
  813. (succeeded? (build-derivations %store (list drv))))
  814. (and succeeded?
  815. (let ((one (derivation->output-path drv))
  816. (two (derivation->output-path drv "second")))
  817. (and (equal? '(hello) (call-with-input-file one read))
  818. (equal? '(world) (call-with-input-file two read)))))))
  819. (test-skip (if %coreutils 0 1))
  820. (test-assert "build-expression->derivation with one input"
  821. (let* ((builder '(call-with-output-file %output
  822. (lambda (p)
  823. (let ((cu (assoc-ref %build-inputs "cu")))
  824. (close 1)
  825. (dup2 (port->fdes p) 1)
  826. (execl (string-append cu "/bin/uname")
  827. "uname" "-a")))))
  828. (drv (build-expression->derivation %store "uname" builder
  829. #:inputs
  830. `(("cu" ,%coreutils))))
  831. (succeeded? (build-derivations %store (list drv))))
  832. (and succeeded?
  833. (let ((p (derivation->output-path drv)))
  834. (string-contains (call-with-input-file p read-line) "GNU")))))
  835. (test-assert "build-expression->derivation with modules"
  836. (let* ((builder `(begin
  837. (use-modules (guix build utils))
  838. (let ((out (assoc-ref %outputs "out")))
  839. (mkdir-p (string-append out "/guile/guix/nix"))
  840. #t)))
  841. (drv (build-expression->derivation %store "test-with-modules"
  842. builder
  843. #:modules
  844. '((guix build utils)))))
  845. (and (build-derivations %store (list drv))
  846. (let* ((p (derivation->output-path drv))
  847. (s (stat (string-append p "/guile/guix/nix"))))
  848. (eq? (stat:type s) 'directory)))))
  849. (test-assert "build-expression->derivation: same fixed-output path"
  850. (let* ((builder1 '(call-with-output-file %output
  851. (lambda (p)
  852. (write "hello" p))))
  853. (builder2 '(call-with-output-file (pk 'difference-here! %output)
  854. (lambda (p)
  855. (write "hello" p))))
  856. (hash (sha256 (string->utf8 "hello")))
  857. (input1 (build-expression->derivation %store "fixed" builder1
  858. #:hash hash
  859. #:hash-algo 'sha256))
  860. (input2 (build-expression->derivation %store "fixed" builder2
  861. #:hash hash
  862. #:hash-algo 'sha256))
  863. (succeeded? (build-derivations %store (list input1 input2))))
  864. (and succeeded?
  865. (not (string=? (derivation-file-name input1)
  866. (derivation-file-name input2)))
  867. (string=? (derivation->output-path input1)
  868. (derivation->output-path input2)))))
  869. (test-assert "build-expression->derivation with a fixed-output input"
  870. (let* ((builder1 '(call-with-output-file %output
  871. (lambda (p)
  872. (write "hello" p))))
  873. (builder2 '(call-with-output-file (pk 'difference-here! %output)
  874. (lambda (p)
  875. (write "hello" p))))
  876. (hash (sha256 (string->utf8 "hello")))
  877. (input1 (build-expression->derivation %store "fixed" builder1
  878. #:hash hash
  879. #:hash-algo 'sha256))
  880. (input2 (build-expression->derivation %store "fixed" builder2
  881. #:hash hash
  882. #:hash-algo 'sha256))
  883. (builder3 '(let ((input (assoc-ref %build-inputs "input")))
  884. (call-with-output-file %output
  885. (lambda (out)
  886. (format #f "My input is ~a.~%" input)))))
  887. (final1 (build-expression->derivation %store "final" builder3
  888. #:inputs
  889. `(("input" ,input1))))
  890. (final2 (build-expression->derivation %store "final" builder3
  891. #:inputs
  892. `(("input" ,input2)))))
  893. (and (string=? (derivation->output-path final1)
  894. (derivation->output-path final2))
  895. (string=? (derivation->output-path final1)
  896. (derivation-path->output-path
  897. (derivation-file-name final1)))
  898. (build-derivations %store (list final1 final2)))))
  899. (test-assert "build-expression->derivation produces recursive fixed-output"
  900. (let* ((builder '(begin
  901. (use-modules (srfi srfi-26))
  902. (mkdir %output)
  903. (chdir %output)
  904. (call-with-output-file "exe"
  905. (cut display "executable" <>))
  906. (chmod "exe" #o777)
  907. (symlink "exe" "symlink")
  908. (mkdir "subdir")))
  909. (drv (build-expression->derivation %store "fixed-rec" builder
  910. #:hash-algo 'sha256
  911. #:hash (base32
  912. "10k1lw41wyrjf9mxydi0is5nkpynlsvgslinics4ppir13g7d74p")
  913. #:recursive? #t)))
  914. (and (build-derivations %store (list drv))
  915. (let* ((dir (derivation->output-path drv))
  916. (exe (string-append dir "/exe"))
  917. (link (string-append dir "/symlink"))
  918. (subdir (string-append dir "/subdir")))
  919. (and (executable-file? exe)
  920. (string=? "executable"
  921. (call-with-input-file exe get-string-all))
  922. (string=? "exe" (readlink link))
  923. (file-is-directory? subdir))))))
  924. (test-assert "build-expression->derivation uses recursive fixed-output"
  925. (let* ((builder '(call-with-output-file %output
  926. (lambda (port)
  927. (display "hello" port))))
  928. (fixed (build-expression->derivation %store "small-fixed-rec"
  929. builder
  930. #:hash-algo 'sha256
  931. #:hash (base32
  932. "0sg9f58l1jj88w6pdrfdpj5x9b1zrwszk84j81zvby36q9whhhqa")
  933. #:recursive? #t))
  934. (in (derivation->output-path fixed))
  935. (builder `(begin
  936. (mkdir %output)
  937. (chdir %output)
  938. (symlink ,in "symlink")))
  939. (drv (build-expression->derivation %store "fixed-rec-user"
  940. builder
  941. #:inputs `(("fixed" ,fixed)))))
  942. (and (build-derivations %store (list drv))
  943. (let ((out (derivation->output-path drv)))
  944. (string=? (readlink (string-append out "/symlink")) in)))))
  945. (test-assert "build-expression->derivation with #:references-graphs"
  946. (let* ((input (add-text-to-store %store "foo" "hello"
  947. (list %bash %mkdir)))
  948. (builder '(copy-file "input" %output))
  949. (drv (build-expression->derivation %store "references-graphs"
  950. builder
  951. #:references-graphs
  952. `(("input" . ,input))))
  953. (out (derivation->output-path drv)))
  954. (define (deps path . deps)
  955. (let ((count (length deps)))
  956. (string-append path "\n\n" (number->string count) "\n"
  957. (string-join (sort deps string<?) "\n")
  958. (if (zero? count) "" "\n"))))
  959. (and (build-derivations %store (list drv))
  960. (equal? (call-with-input-file out get-string-all)
  961. (string-concatenate
  962. (map cdr
  963. (sort (map (lambda (p d)
  964. (cons p (apply deps p d)))
  965. (list input %bash %mkdir)
  966. (list (list %bash %mkdir)
  967. '() '()))
  968. (lambda (x y)
  969. (match x
  970. ((p1 . _)
  971. (match y
  972. ((p2 . _)
  973. (string<? p1 p2)))))))))))))
  974. (test-equal "map-derivation"
  975. "hello"
  976. (let* ((joke (package-derivation %store guile-1.8))
  977. (good (package-derivation %store %bootstrap-guile))
  978. (drv1 (build-expression->derivation %store "original-drv1"
  979. #f ; systematically fail
  980. #:guile-for-build joke))
  981. (drv2 (build-expression->derivation %store "original-drv2"
  982. '(call-with-output-file %output
  983. (lambda (p)
  984. (display "hello" p)))))
  985. (drv3 (build-expression->derivation %store "drv-to-remap"
  986. '(let ((in (assoc-ref
  987. %build-inputs "in")))
  988. (copy-file in %output))
  989. #:inputs `(("in" ,drv1))
  990. #:guile-for-build joke))
  991. (drv4 (map-derivation %store drv3 `((,drv1 . ,drv2)
  992. (,joke . ,good))))
  993. (out (derivation->output-path drv4)))
  994. (and (build-derivations %store (list (pk 'remapped drv4)))
  995. (call-with-input-file out get-string-all))))
  996. (test-equal "map-derivation, sources"
  997. "hello"
  998. (let* ((script1 (add-text-to-store %store "fail.sh" "exit 1"))
  999. (script2 (add-text-to-store %store "hi.sh" "echo -n hello > $out"))
  1000. (bash-full (package-derivation %store (@ (gnu packages bash) bash)))
  1001. (drv1 (derivation %store "drv-to-remap"
  1002. ;; XXX: This wouldn't work in practice, but if
  1003. ;; we append "/bin/bash" then we can't replace
  1004. ;; it with the bootstrap bash, which is a
  1005. ;; single file.
  1006. (derivation->output-path bash-full)
  1007. `("-e" ,script1)
  1008. #:inputs `((,bash-full) (,script1))))
  1009. (drv2 (map-derivation %store drv1
  1010. `((,bash-full . ,%bash)
  1011. (,script1 . ,script2))))
  1012. (out (derivation->output-path drv2)))
  1013. (and (build-derivations %store (list (pk 'remapped* drv2)))
  1014. (call-with-input-file out get-string-all))))
  1015. (test-end)