;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+(unsetenv "http_proxy")
+
(define-module (test-derivations)
#:use-module (guix derivations)
#:use-module (guix grafts)
#:use-module (guix hash)
#:use-module (guix base32)
#:use-module (guix tests)
+ #:use-module (guix tests http)
#:use-module ((guix packages) #:select (package-derivation base32))
#:use-module ((guix build utils) #:select (executable-file?))
#:use-module ((gnu packages) #:select (search-bootstrap-binary))
(lambda (e1 e2)
(string<? (car e1) (car e2)))))
+;; Avoid collisions with other tests.
+(%http-server-port 10500)
+
\f
(test-begin "derivations")
(= (stat:ino (lstat file1))
(stat:ino (lstat file2))))))))
+(test-equal "built-in-builders"
+ '("download")
+ (built-in-builders %store))
+
+(test-assert "unknown built-in builder"
+ (let ((drv (derivation %store "ohoh" "builtin:does-not-exist" '())))
+ (guard (c ((nix-protocol-error? c)
+ (string-contains (nix-protocol-error-message c) "failed")))
+ (build-derivations %store (list drv))
+ #f)))
+
+(unless (force %http-server-socket)
+ (test-skip 1))
+(test-assert "'download' built-in builder"
+ (let ((text (random-text)))
+ (with-http-server 200 text
+ (let* ((drv (derivation %store "world"
+ "builtin:download" '()
+ #:env-vars `(("url"
+ . ,(object->string (%local-url))))
+ #:hash-algo 'sha256
+ #:hash (sha256 (string->utf8 text)))))
+ (and (build-derivations %store (list drv))
+ (string=? (call-with-input-file (derivation->output-path drv)
+ get-string-all)
+ text))))))
+
+(unless (force %http-server-socket)
+ (test-skip 1))
+(test-assert "'download' built-in builder, invalid hash"
+ (with-http-server 200 "hello, world!"
+ (let* ((drv (derivation %store "world"
+ "builtin:download" '()
+ #:env-vars `(("url"
+ . ,(object->string (%local-url))))
+ #:hash-algo 'sha256
+ #:hash (sha256 (random-bytevector 100))))) ;wrong
+ (guard (c ((nix-protocol-error? c)
+ (string-contains (nix-protocol-error-message c) "failed")))
+ (build-derivations %store (list drv))
+ #f))))
+
+(unless (force %http-server-socket)
+ (test-skip 1))
+(test-assert "'download' built-in builder, not found"
+ (with-http-server 404 "not found"
+ (let* ((drv (derivation %store "will-never-be-found"
+ "builtin:download" '()
+ #:env-vars `(("url"
+ . ,(object->string (%local-url))))
+ #:hash-algo 'sha256
+ #:hash (sha256 (random-bytevector 100)))))
+ (guard (c ((nix-protocol-error? c)
+ (string-contains (nix-protocol-error-message (pk c)) "failed")))
+ (build-derivations %store (list drv))
+ #f))))
+
+(test-assert "'download' built-in builder, not fixed-output"
+ (let* ((source (add-text-to-store %store "hello" "hi!"))
+ (url (string-append "file://" source))
+ (drv (derivation %store "world"
+ "builtin:download" '()
+ #:env-vars `(("url" . ,(object->string url))))))
+ (guard (c ((nix-protocol-error? c)
+ (string-contains (nix-protocol-error-message c) "failed")))
+ (build-derivations %store (list drv))
+ #f)))
+
+(unless (force %http-server-socket)
+ (test-skip 1))
+(test-assert "'download' built-in builder, check mode"
+ ;; Make sure rebuilding the 'builtin:download' derivation in check mode
+ ;; works. See <http://bugs.gnu.org/25089>.
+ (let* ((text (random-text))
+ (drv (derivation %store "world"
+ "builtin:download" '()
+ #:env-vars `(("url"
+ . ,(object->string (%local-url))))
+ #:hash-algo 'sha256
+ #:hash (sha256 (string->utf8 text)))))
+ (and (with-http-server 200 text
+ (build-derivations %store (list drv)))
+ (with-http-server 200 text
+ (build-derivations %store (list drv)
+ (build-mode check)))
+ (string=? (call-with-input-file (derivation->output-path drv)
+ get-string-all)
+ text))))
+
(test-equal "derivation-name"
"foo-0.0"
(let ((drv (derivation %store "foo-0.0" %bash '())))
(and (eq? 'one (call-with-input-file one read))
(eq? 'two (call-with-input-file two read)))))))
+(test-assert "read-derivation vs. derivation"
+ ;; Make sure 'derivation' and 'read-derivation' return objects that are
+ ;; identical.
+ (let* ((sources (unfold (cut >= <> 10)
+ (lambda (n)
+ (add-text-to-store %store
+ (format #f "input~a" n)
+ (random-text)))
+ 1+
+ 0))
+ (inputs (map (lambda (file)
+ (derivation %store "derivation-input"
+ %bash '()
+ #:inputs `((,%bash) (,file))))
+ sources))
+ (builder (add-text-to-store %store "builder.sh"
+ "echo one > $one ; echo two > $two"
+ '()))
+ (drv (derivation %store "derivation"
+ %bash `(,builder)
+ #:inputs `((,%bash) (,builder)
+ ,@(map list (append sources inputs)))
+ #:outputs '("two" "one")))
+ (drv* (call-with-input-file (derivation-file-name drv)
+ read-derivation)))
+ (equal? drv* drv)))
+
(test-assert "multiple-output derivation, derivation-path->output-path"
(let* ((builder (add-text-to-store %store "builder.sh"
"echo one > $out ; echo two > $second"
(test-skip (if (%guile-for-build) 0 8))
+(test-equal "build-expression->derivation and invalid module name"
+ '(file-search-error "guix/module/that/does/not/exist.scm")
+ (guard (c ((file-search-error? c)
+ (list 'file-search-error
+ (file-search-error-file-name c))))
+ (build-expression->derivation %store "foo" #t
+ #:modules '((guix module that
+ does not exist)))))
+
(test-assert "build-expression->derivation and derivation-prerequisites"
(let ((drv (build-expression->derivation %store "fail" #f)))
(any (match-lambda
(string=? (derivation-input-path input)
(derivation-file-name dep))))))))
+(test-assert "substitution-oracle and #:substitute? #f"
+ (with-store store
+ (let* ((dep (build-expression->derivation store "dep"
+ `(begin ,(random-text)
+ (mkdir %output))))
+ (drv (build-expression->derivation store "not-subst"
+ `(begin ,(random-text)
+ (mkdir %output))
+ #:substitutable? #f
+ #:inputs `(("dep" ,dep))))
+ (query #f))
+ (define (record-substitutable-path-query store paths)
+ (when query
+ (error "already called!" query))
+ (set! query paths)
+ '())
+
+ (mock ((guix store) substitutable-paths
+ record-substitutable-path-query)
+
+ (let ((pred (substitution-oracle store (list drv))))
+ (pred (derivation->output-path drv))))
+
+ ;; Make sure the oracle didn't try to get substitute info for DRV since
+ ;; DRV is mark as non-substitutable. Assume that GUILE-FOR-BUILD is
+ ;; already in store and thus not part of QUERY.
+ (equal? (pk 'query query)
+ (list (derivation->output-path dep))))))
+
(test-assert "build-expression->derivation with expression returning #f"
(let* ((builder '(begin
(mkdir %output)
(test-end)
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
+;; Local Variables:
+;; eval: (put 'with-http-server 'scheme-indent-function 2)
+;; End:
HCoop / jackhill / guix / guix.git / blobdiff