Mirror of GNU Guix
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.

214 lines
9.4 KiB

  1. ;;; Guix --- Nix package management from Guile. -*- coding: utf-8 -*-
  2. ;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org>
  3. ;;;
  4. ;;; This file is part of Guix.
  5. ;;;
  6. ;;; 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. ;;; 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 Guix. If not, see <http://www.gnu.org/licenses/>.
  18. (define-module (test-derivations)
  19. #:use-module (guix derivations)
  20. #:use-module (guix store)
  21. #:use-module (guix utils)
  22. #:use-module (srfi srfi-11)
  23. #:use-module (srfi srfi-26)
  24. #:use-module (srfi srfi-64)
  25. #:use-module (rnrs io ports)
  26. #:use-module (rnrs bytevectors)
  27. #:use-module (ice-9 rdelim))
  28. (define %store
  29. (false-if-exception (open-connection)))
  30. (test-begin "derivations")
  31. (test-assert "parse & export"
  32. (let* ((f (search-path %load-path "tests/test.drv"))
  33. (b1 (call-with-input-file f get-bytevector-all))
  34. (d1 (read-derivation (open-bytevector-input-port b1)))
  35. (b2 (call-with-bytevector-output-port (cut write-derivation d1 <>)))
  36. (d2 (read-derivation (open-bytevector-input-port b2))))
  37. (and (equal? b1 b2)
  38. (equal? d1 d2))))
  39. (test-skip (if %store 0 3))
  40. (test-assert "derivation with no inputs"
  41. (let ((builder (add-text-to-store %store "my-builder.sh"
  42. "#!/bin/sh\necho hello, world\n"
  43. '())))
  44. (store-path? (derivation %store "foo" "x86_64-linux" builder
  45. '() '(("HOME" . "/homeless")) '()))))
  46. (test-assert "build derivation with 1 source"
  47. (let*-values (((builder)
  48. (add-text-to-store %store "my-builder.sh"
  49. "echo hello, world > \"$out\"\n"
  50. '()))
  51. ((drv-path drv)
  52. (derivation %store "foo" "x86_64-linux"
  53. "/bin/sh" `(,builder)
  54. '(("HOME" . "/homeless")
  55. ("zzz" . "Z!")
  56. ("AAA" . "A!"))
  57. `((,builder))))
  58. ((succeeded?)
  59. (build-derivations %store (list drv-path))))
  60. (and succeeded?
  61. (let ((path (derivation-output-path
  62. (assoc-ref (derivation-outputs drv) "out"))))
  63. (string=? (call-with-input-file path read-line)
  64. "hello, world")))))
  65. (test-assert "fixed-output derivation"
  66. (let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
  67. "echo -n hello > $out" '()))
  68. (hash (sha256 (string->utf8 "hello")))
  69. (drv-path (derivation %store "fixed" "x86_64-linux"
  70. "/bin/sh" `(,builder)
  71. '() `((,builder))
  72. #:hash hash #:hash-algo 'sha256))
  73. (succeeded? (build-derivations %store (list drv-path))))
  74. (and succeeded?
  75. (let ((p (derivation-path->output-path drv-path)))
  76. (equal? (string->utf8 "hello")
  77. (call-with-input-file p get-bytevector-all))))))
  78. (test-assert "multiple-output derivation"
  79. (let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
  80. "echo one > $out ; echo two > $second"
  81. '()))
  82. (drv-path (derivation %store "fixed" "x86_64-linux"
  83. "/bin/sh" `(,builder)
  84. '(("HOME" . "/homeless")
  85. ("zzz" . "Z!")
  86. ("AAA" . "A!"))
  87. `((,builder))
  88. #:outputs '("out" "second")))
  89. (succeeded? (build-derivations %store (list drv-path))))
  90. (and succeeded?
  91. (let ((one (derivation-path->output-path drv-path "out"))
  92. (two (derivation-path->output-path drv-path "second")))
  93. (and (eq? 'one (call-with-input-file one read))
  94. (eq? 'two (call-with-input-file two read)))))))
  95. (define %coreutils
  96. (false-if-exception (nixpkgs-derivation "coreutils")))
  97. (test-skip (if %coreutils 0 1))
  98. (test-assert "build derivation with coreutils"
  99. (let* ((builder
  100. (add-text-to-store %store "build-with-coreutils.sh"
  101. "echo $PATH ; mkdir --version ; mkdir $out ; touch $out/good"
  102. '()))
  103. (drv-path
  104. (derivation %store "foo" "x86_64-linux"
  105. "/bin/sh" `(,builder)
  106. `(("PATH" .
  107. ,(string-append
  108. (derivation-path->output-path %coreutils)
  109. "/bin")))
  110. `((,builder)
  111. (,%coreutils))))
  112. (succeeded?
  113. (build-derivations %store (list drv-path))))
  114. (and succeeded?
  115. (let ((p (derivation-path->output-path drv-path)))
  116. (file-exists? (string-append p "/good"))))))
  117. (test-skip (if (%guile-for-build) 0 2))
  118. (test-assert "build-expression->derivation without inputs"
  119. (let* ((builder '(begin
  120. (mkdir %output)
  121. (call-with-output-file (string-append %output "/test")
  122. (lambda (p)
  123. (display '(hello guix) p)))))
  124. (drv-path (build-expression->derivation %store "goo" "x86_64-linux"
  125. builder '()))
  126. (succeeded? (build-derivations %store (list drv-path))))
  127. (and succeeded?
  128. (let ((p (derivation-path->output-path drv-path)))
  129. (equal? '(hello guix)
  130. (call-with-input-file (string-append p "/test") read))))))
  131. (test-assert "build-expression->derivation with two outputs"
  132. (let* ((builder '(begin
  133. (call-with-output-file (assoc-ref %outputs "out")
  134. (lambda (p)
  135. (display '(hello) p)))
  136. (call-with-output-file (assoc-ref %outputs "second")
  137. (lambda (p)
  138. (display '(world) p)))))
  139. (drv-path (build-expression->derivation %store "double"
  140. "x86_64-linux"
  141. builder '()
  142. #:outputs '("out"
  143. "second")))
  144. (succeeded? (build-derivations %store (list drv-path))))
  145. (and succeeded?
  146. (let ((one (derivation-path->output-path drv-path))
  147. (two (derivation-path->output-path drv-path "second")))
  148. (and (equal? '(hello) (call-with-input-file one read))
  149. (equal? '(world) (call-with-input-file two read)))))))
  150. (test-assert "build-expression->derivation with one input"
  151. (let* ((builder '(call-with-output-file %output
  152. (lambda (p)
  153. (let ((cu (assoc-ref %build-inputs "cu")))
  154. (close 1)
  155. (dup2 (port->fdes p) 1)
  156. (execl (string-append cu "/bin/uname")
  157. "uname" "-a")))))
  158. (drv-path (build-expression->derivation %store "uname" "x86_64-linux"
  159. builder
  160. `(("cu" . ,%coreutils))))
  161. (succeeded? (build-derivations %store (list drv-path))))
  162. (and succeeded?
  163. (let ((p (derivation-path->output-path drv-path)))
  164. (string-contains (call-with-input-file p read-line) "GNU")))))
  165. (test-skip (if (false-if-exception (getaddrinfo "ftp.gnu.org" "http"))
  166. 0
  167. 1))
  168. (test-assert "build-expression->derivation for fixed-output derivation"
  169. (let* ((url "http://ftp.gnu.org/gnu/hello/hello-2.8.tar.gz")
  170. (builder `(begin
  171. (use-modules (web client) (web uri)
  172. (rnrs io ports))
  173. (let ((bv (http-get (string->uri ,url)
  174. #:decode-body? #f)))
  175. (call-with-output-file %output
  176. (lambda (p)
  177. (put-bytevector p bv))))))
  178. (drv-path (build-expression->derivation
  179. %store "hello-2.8.tar.gz" "x86_64-linux" builder '()
  180. #:hash (nix-base32-string->bytevector
  181. "0wqd8sjmxfskrflaxywc7gqw7sfawrfvdxd9skxawzfgyy0pzdz6")
  182. #:hash-algo 'sha256))
  183. (succeeded? (build-derivations %store (list drv-path))))
  184. (and succeeded?
  185. (file-exists? (derivation-path->output-path drv-path)))))
  186. (test-end)
  187. (exit (= (test-runner-fail-count (test-runner-current)) 0))
  188. ;;; Local Variables:
  189. ;;; eval: (put 'test-assert 'scheme-indent-function 1)
  190. ;;; End: