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.
 
 
 
 
 
 

174 lines
6.4 KiB

  1. ;;; GNU Guix --- Functional package management for GNU
  2. ;;; Copyright © 2012, 2013 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. (define-module (test-store)
  19. #:use-module (guix store)
  20. #:use-module (guix utils)
  21. #:use-module (guix base32)
  22. #:use-module (guix packages)
  23. #:use-module (guix derivations)
  24. #:use-module (gnu packages)
  25. #:use-module (gnu packages bootstrap)
  26. #:use-module (ice-9 match)
  27. #:use-module (web uri)
  28. #:use-module (srfi srfi-1)
  29. #:use-module (srfi srfi-11)
  30. #:use-module (srfi srfi-64))
  31. ;; Test the (guix store) module.
  32. (define %store
  33. (false-if-exception (open-connection)))
  34. (when %store
  35. ;; Make sure we build everything by ourselves.
  36. (set-build-options %store #:use-substitutes? #f))
  37. (define %seed
  38. (seed->random-state (logxor (getpid) (car (gettimeofday)))))
  39. (define (random-text)
  40. (number->string (random (expt 2 256) %seed) 16))
  41. (test-begin "store")
  42. (test-equal "store-path-hash-part"
  43. "283gqy39v3g9dxjy26rynl0zls82fmcg"
  44. (store-path-hash-part
  45. (string-append (%store-prefix)
  46. "/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7")))
  47. (test-equal "store-path-hash-part #f"
  48. #f
  49. (store-path-hash-part
  50. (string-append (%store-prefix)
  51. "/foo/bar/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7")))
  52. (test-skip (if %store 0 10))
  53. (test-assert "dead-paths"
  54. (let ((p (add-text-to-store %store "random-text"
  55. (random-text) '())))
  56. (member p (dead-paths %store))))
  57. ;; FIXME: Find a test for `live-paths'.
  58. ;;
  59. ;; (test-assert "temporary root is in live-paths"
  60. ;; (let* ((p1 (add-text-to-store %store "random-text"
  61. ;; (random-text) '()))
  62. ;; (b (add-text-to-store %store "link-builder"
  63. ;; (format #f "echo ~a > $out" p1)
  64. ;; '()))
  65. ;; (d1 (derivation %store "link" (%current-system)
  66. ;; "/bin/sh" `("-e" ,b) '()
  67. ;; `((,b) (,p1))))
  68. ;; (p2 (derivation-path->output-path d1)))
  69. ;; (and (add-temp-root %store p2)
  70. ;; (build-derivations %store (list d1))
  71. ;; (valid-path? %store p1)
  72. ;; (member (pk p2) (live-paths %store)))))
  73. (test-assert "dead path can be explicitly collected"
  74. (let ((p (add-text-to-store %store "random-text"
  75. (random-text) '())))
  76. (let-values (((paths freed) (delete-paths %store (list p))))
  77. (and (equal? paths (list p))
  78. (> freed 0)
  79. (not (file-exists? p))))))
  80. (test-assert "references"
  81. (let* ((t1 (add-text-to-store %store "random1"
  82. (random-text) '()))
  83. (t2 (add-text-to-store %store "random2"
  84. (random-text) (list t1))))
  85. (and (equal? (list t1) (references %store t2))
  86. (equal? (list t2) (referrers %store t1))
  87. (null? (references %store t1))
  88. (null? (referrers %store t2)))))
  89. (test-assert "derivers"
  90. (let* ((b (add-text-to-store %store "build" "echo $foo > $out" '()))
  91. (s (add-to-store %store "bash" #t "sha256"
  92. (search-bootstrap-binary "bash"
  93. (%current-system))))
  94. (d (derivation %store "the-thing" (%current-system)
  95. s `("-e" ,b) `(("foo" . ,(random-text)))
  96. `((,b) (,s))))
  97. (o (derivation-path->output-path d)))
  98. (and (build-derivations %store (list d))
  99. (equal? (query-derivation-outputs %store d)
  100. (list o))
  101. (equal? (valid-derivers %store o)
  102. (list d)))))
  103. (test-assert "no substitutes"
  104. (let* ((s (open-connection))
  105. (d1 (package-derivation s %bootstrap-guile (%current-system)))
  106. (d2 (package-derivation s %bootstrap-glibc (%current-system)))
  107. (o (map derivation-path->output-path (list d1 d2))))
  108. (set-build-options s #:use-substitutes? #f)
  109. (and (not (has-substitutes? s d1))
  110. (not (has-substitutes? s d2))
  111. (null? (substitutable-paths s o))
  112. (null? (substitutable-path-info s o)))))
  113. (test-skip (if (getenv "GUIX_BINARY_SUBSTITUTE_URL") 0 1))
  114. (test-assert "substitute query"
  115. (let* ((s (open-connection))
  116. (d (package-derivation s %bootstrap-guile (%current-system)))
  117. (o (derivation-path->output-path d))
  118. (dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL")
  119. (compose uri-path string->uri))))
  120. ;; Create fake substituter data, to be read by `substitute-binary'.
  121. (call-with-output-file (string-append dir "/nix-cache-info")
  122. (lambda (p)
  123. (format p "StoreDir: ~a\nWantMassQuery: 0\n"
  124. (getenv "NIX_STORE_DIR"))))
  125. (call-with-output-file (string-append dir "/" (store-path-hash-part o)
  126. ".narinfo")
  127. (lambda (p)
  128. (format p "StorePath: ~a
  129. URL: ~a
  130. Compression: none
  131. NarSize: 1234
  132. References:
  133. System: ~a
  134. Deriver: ~a~%"
  135. o ; StorePath
  136. (string-append dir "/example.nar") ; URL
  137. (%current-system) ; System
  138. (basename d)))) ; Deriver
  139. ;; Make sure `substitute-binary' correctly communicates the above data.
  140. (set-build-options s #:use-substitutes? #t)
  141. (and (has-substitutes? s o)
  142. (equal? (list o) (substitutable-paths s (list o)))
  143. (match (pk 'spi (substitutable-path-info s (list o)))
  144. (((? substitutable? s))
  145. (and (equal? (substitutable-deriver s) d)
  146. (null? (substitutable-references s))
  147. (equal? (substitutable-nar-size s) 1234)))))))
  148. (test-end "store")
  149. (exit (= (test-runner-fail-count (test-runner-current)) 0))