[jackhill/guix/guix.git] / tests / derivations.scm

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.


(define-module (test-derivations)
  #:use-module (guix derivations)
  #:use-module (guix store)
  #:use-module (guix utils)
  #:use-module (guix base32)
  #:use-module ((guix packages) #:select (package-derivation))
  #:use-module (distro packages bootstrap)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-11)
  #:use-module (srfi srfi-26)
  #:use-module (srfi srfi-34)
  #:use-module (srfi srfi-64)
  #:use-module (rnrs io ports)
  #:use-module (rnrs bytevectors)
  #:use-module (ice-9 rdelim)
  #:use-module (ice-9 regex)
  #:use-module (ice-9 ftw)
  #:use-module (ice-9 match))

(define %store
  (false-if-exception (open-connection)))

(when %store
  ;; Make sure we build everything by ourselves.
  (set-build-options %store #:use-substitutes? #f)

  ;; By default, use %BOOTSTRAP-GUILE for the current system.
  (let ((drv (package-derivation %store %bootstrap-guile)))
    (%guile-for-build drv)))

(define (directory-contents dir)
  "Return an alist representing the contents of DIR."
  (define prefix-len (string-length dir))
  (sort (file-system-fold (const #t)                   ; enter?
                          (lambda (path stat result)   ; leaf
                            (alist-cons (string-drop path prefix-len)
                                        (call-with-input-file path
                                          get-bytevector-all)
                                        result))
                          (lambda (path stat result) result)      ; down
                          (lambda (path stat result) result)      ; up
                          (lambda (path stat result) result)      ; skip
                          (lambda (path stat errno result) result) ; error
                          '()
                          dir)
        (lambda (e1 e2)
          (string<? (car e1) (car e2)))))

(test-begin "derivations")

(test-assert "parse & export"
  (let* ((f  (search-path %load-path "tests/test.drv"))
         (b1 (call-with-input-file f get-bytevector-all))
         (d1 (read-derivation (open-bytevector-input-port b1)))
         (b2 (call-with-bytevector-output-port (cut write-derivation d1 <>)))
         (d2 (read-derivation (open-bytevector-input-port b2))))
    (and (equal? b1 b2)
         (equal? d1 d2))))

(test-skip (if %store 0 11))

(test-assert "add-to-store, flat"
  (let* ((file (search-path %load-path "language/tree-il/spec.scm"))
         (drv  (add-to-store %store "flat-test" #t #f "sha256" file)))
    (and (eq? 'regular (stat:type (stat drv)))
         (valid-path? %store drv)
         (equal? (call-with-input-file file get-bytevector-all)
                 (call-with-input-file drv get-bytevector-all)))))

(test-assert "add-to-store, recursive"
  (let* ((dir (dirname (search-path %load-path "language/tree-il/spec.scm")))
         (drv (add-to-store %store "dir-tree-test" #t #t "sha256" dir)))
    (and (eq? 'directory (stat:type (stat drv)))
         (valid-path? %store drv)
         (equal? (directory-contents dir)
                 (directory-contents drv)))))

(test-assert "derivation with no inputs"
  (let* ((builder  (add-text-to-store %store "my-builder.sh"
                                      "#!/bin/sh\necho hello, world\n"
                                      '()))
         (drv-path (derivation %store "foo" (%current-system) builder
                               '() '(("HOME" . "/homeless")) '())))
    (and (store-path? drv-path)
         (valid-path? %store drv-path))))

(test-assert "build derivation with 1 source"
  (let*-values (((builder)
                 (add-text-to-store %store "my-builder.sh"
                                    "echo hello, world > \"$out\"\n"
                                    '()))
                ((drv-path drv)
                 (derivation %store "foo" (%current-system)
                             "/bin/sh" `(,builder)
                             '(("HOME" . "/homeless")
                               ("zzz"  . "Z!")
                               ("AAA"  . "A!"))
                             `((,builder))))
                ((succeeded?)
                 (build-derivations %store (list drv-path))))
    (and succeeded?
         (let ((path (derivation-output-path
                      (assoc-ref (derivation-outputs drv) "out"))))
           (and (valid-path? %store path)
                (string=? (call-with-input-file path read-line)
                          "hello, world"))))))

(test-assert "derivation with local file as input"
  (let* ((builder    (add-text-to-store
                      %store "my-builder.sh"
                      "(while read line ; do echo $line ; done) < $in > $out"
                      '()))
         (input      (search-path %load-path "ice-9/boot-9.scm"))
         (drv-path   (derivation %store "derivation-with-input-file"
                                 (%current-system)
                                 "/bin/sh" `(,builder)
                                 `(("in"
                                    ;; Cheat to pass the actual file
                                    ;; name to the builder.
                                    . ,(add-to-store %store
                                                     (basename input)
                                                     #t #t "sha256"
                                                     input)))
                                 `((,builder)
                                   (,input)))))   ; ← local file name
    (and (build-derivations %store (list drv-path))
         (let ((p (derivation-path->output-path drv-path)))
           (and (call-with-input-file p get-bytevector-all)
                (call-with-input-file input get-bytevector-all))))))

(test-assert "fixed-output derivation"
  (let* ((builder    (add-text-to-store %store "my-fixed-builder.sh"
                                        "echo -n hello > $out" '()))
         (hash       (sha256 (string->utf8 "hello")))
         (drv-path   (derivation %store "fixed" (%current-system)
                                 "/bin/sh" `(,builder)
                                 '()
                                 `((,builder))    ; optional
                                 #:hash hash #:hash-algo 'sha256))
         (succeeded? (build-derivations %store (list drv-path))))
    (and succeeded?
         (let ((p (derivation-path->output-path drv-path)))
           (and (equal? (string->utf8 "hello")
                        (call-with-input-file p get-bytevector-all))
                (bytevector? (query-path-hash %store p)))))))

(test-assert "fixed-output derivation: output paths are equal"
  (let* ((builder1   (add-text-to-store %store "fixed-builder1.sh"
                                        "echo -n hello > $out" '()))
         (builder2   (add-text-to-store %store "fixed-builder2.sh"
                                        "echo hey; echo -n hello > $out" '()))
         (hash       (sha256 (string->utf8 "hello")))
         (drv-path1  (derivation %store "fixed" (%current-system)
                                 "/bin/sh" `(,builder1)
                                 '() `()
                                 #:hash hash #:hash-algo 'sha256))
         (drv-path2  (derivation %store "fixed" (%current-system)
                                 "/bin/sh" `(,builder2)
                                 '() `()
                                 #:hash hash #:hash-algo 'sha256))
         (succeeded? (build-derivations %store
                                        (list drv-path1 drv-path2))))
    (and succeeded?
         (equal? (derivation-path->output-path drv-path1)
                 (derivation-path->output-path drv-path2)))))

(test-assert "derivation with a fixed-output input"
  ;; A derivation D using a fixed-output derivation F doesn't has the same
  ;; output path when passed F or F', as long as F and F' have the same output
  ;; path.
  (let* ((builder1   (add-text-to-store %store "fixed-builder1.sh"
                                        "echo -n hello > $out" '()))
         (builder2   (add-text-to-store %store "fixed-builder2.sh"
                                        "echo hey; echo -n hello > $out" '()))
         (hash       (sha256 (string->utf8 "hello")))
         (fixed1     (derivation %store "fixed" (%current-system)
                                 "/bin/sh" `(,builder1)
                                 '() `()
                                 #:hash hash #:hash-algo 'sha256))
         (fixed2     (derivation %store "fixed" (%current-system)
                                 "/bin/sh" `(,builder2)
                                 '() `()
                                 #:hash hash #:hash-algo 'sha256))
         (fixed-out  (derivation-path->output-path fixed1))
         (builder3   (add-text-to-store
                      %store "final-builder.sh"
                      ;; Use Bash hackery to avoid Coreutils.
                      "echo $in ; (read -u 3 c; echo $c) 3< $in > $out" '()))
         (final1     (derivation %store "final" (%current-system)
                                 "/bin/sh" `(,builder3)
                                 `(("in" . ,fixed-out))
                                 `((,builder3) (,fixed1))))
         (final2     (derivation %store "final" (%current-system)
                                 "/bin/sh" `(,builder3)
                                 `(("in" . ,fixed-out))
                                 `((,builder3) (,fixed2))))
         (succeeded? (build-derivations %store
                                        (list final1 final2))))
    (and succeeded?
         (equal? (derivation-path->output-path final1)
                 (derivation-path->output-path final2)))))

(test-assert "multiple-output derivation"
  (let* ((builder    (add-text-to-store %store "my-fixed-builder.sh"
                                        "echo one > $out ; echo two > $second"
                                        '()))
         (drv-path   (derivation %store "fixed" (%current-system)
                                 "/bin/sh" `(,builder)
                                 '(("HOME" . "/homeless")
                                   ("zzz"  . "Z!")
                                   ("AAA"  . "A!"))
                                 `((,builder))
                                 #:outputs '("out" "second")))
         (succeeded? (build-derivations %store (list drv-path))))
    (and succeeded?
         (let ((one (derivation-path->output-path drv-path "out"))
               (two (derivation-path->output-path drv-path "second")))
           (and (lset= equal?
                       (derivation-path->output-paths drv-path)
                       `(("out" . ,one) ("second" . ,two)))
                (eq? 'one (call-with-input-file one read))
                (eq? 'two (call-with-input-file two read)))))))

(test-assert "multiple-output derivation, non-alphabetic order"
  ;; Here, the outputs are not listed in alphabetic order.  Yet, the store
  ;; path computation must reorder them first.
  (let* ((builder    (add-text-to-store %store "my-fixed-builder.sh"
                                        "echo one > $out ; echo two > $AAA"
                                        '()))
         (drv-path   (derivation %store "fixed" (%current-system)
                                 "/bin/sh" `(,builder)
                                 '()
                                 `((,builder))
                                 #:outputs '("out" "AAA")))
         (succeeded? (build-derivations %store (list drv-path))))
    (and succeeded?
         (let ((one (derivation-path->output-path drv-path "out"))
               (two (derivation-path->output-path drv-path "AAA")))
           (and (eq? 'one (call-with-input-file one read))
                (eq? 'two (call-with-input-file two read)))))))

(test-assert "user of multiple-output derivation"
  ;; Check whether specifying several inputs coming from the same
  ;; multiple-output derivation works.
  (let* ((builder1   (add-text-to-store %store "my-mo-builder.sh"
                                        "echo one > $out ; echo two > $two"
                                        '()))
         (mdrv       (derivation %store "multiple-output" (%current-system)
                                 "/bin/sh" `(,builder1)
                                 '()
                                 `((,builder1))
                                 #:outputs '("out" "two")))
         (builder2   (add-text-to-store %store "my-mo-user-builder.sh"
                                        "read x < $one;
                                         read y < $two;
                                         echo \"($x $y)\" > $out"
                                        '()))
         (udrv       (derivation %store "multiple-output-user"
                                 (%current-system)
                                 "/bin/sh" `(,builder2)
                                 `(("one" . ,(derivation-path->output-path
                                              mdrv "out"))
                                   ("two" . ,(derivation-path->output-path
                                              mdrv "two")))
                                 `((,builder2)
                                   ;; two occurrences of MDRV:
                                   (,mdrv)
                                   (,mdrv "two")))))
    (and (build-derivations %store (list (pk 'udrv udrv)))
         (let ((p (derivation-path->output-path udrv)))
           (and (valid-path? %store p)
                (equal? '(one two) (call-with-input-file p read)))))))

\f
(define %coreutils
  (false-if-exception
   (and (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)
        (or (package-derivation %store %bootstrap-coreutils&co)
            (nixpkgs-derivation "coreutils")))))

(test-skip (if %coreutils 0 1))

(test-assert "build derivation with coreutils"
  (let* ((builder
          (add-text-to-store %store "build-with-coreutils.sh"
                             "echo $PATH ; mkdir --version ; mkdir $out ; touch $out/good"
                             '()))
         (drv-path
          (derivation %store "foo" (%current-system)
                      "/bin/sh" `(,builder)
                      `(("PATH" .
                         ,(string-append
                           (derivation-path->output-path %coreutils)
                           "/bin")))
                      `((,builder)
                        (,%coreutils))))
         (succeeded?
          (build-derivations %store (list drv-path))))
    (and succeeded?
         (let ((p (derivation-path->output-path drv-path)))
           (and (valid-path? %store p)
                (file-exists? (string-append p "/good")))))))

(test-skip (if (%guile-for-build) 0 7))

(test-assert "build-expression->derivation and derivation-prerequisites"
  (let-values (((drv-path drv)
                (build-expression->derivation %store "fail" (%current-system)
                                              #f '())))
    (any (match-lambda
          (($ <derivation-input> path)
           (string=? path (%guile-for-build))))
         (derivation-prerequisites drv))))

(test-assert "build-expression->derivation without inputs"
  (let* ((builder    '(begin
                        (mkdir %output)
                        (call-with-output-file (string-append %output "/test")
                          (lambda (p)
                            (display '(hello guix) p)))))
         (drv-path   (build-expression->derivation %store "goo" (%current-system)
                                                   builder '()))
         (succeeded? (build-derivations %store (list drv-path))))
    (and succeeded?
         (let ((p (derivation-path->output-path drv-path)))
           (equal? '(hello guix)
                   (call-with-input-file (string-append p "/test") read))))))

(test-assert "build-expression->derivation and derivation-prerequisites-to-build"
  (let-values (((drv-path drv)
                (build-expression->derivation %store "fail" (%current-system)
                                              #f '())))
    ;; The only direct dependency is (%guile-for-build) and it's already
    ;; built.
    (null? (derivation-prerequisites-to-build %store drv))))

(test-assert "build-expression->derivation with expression returning #f"
  (let* ((builder  '(begin
                      (mkdir %output)
                      #f))                        ; fail!
         (drv-path (build-expression->derivation %store "fail" (%current-system)
                                                 builder '()))
         (out-path (derivation-path->output-path drv-path)))
    (guard (c ((nix-protocol-error? c)
               ;; Note that the output path may exist at this point, but it
               ;; is invalid.
               (and (string-match "build .* failed"
                                  (nix-protocol-error-message c))
                    (not (valid-path? %store out-path)))))
      (build-derivations %store (list drv-path))
      #f)))

(test-assert "build-expression->derivation with two outputs"
  (let* ((builder    '(begin
                        (call-with-output-file (assoc-ref %outputs "out")
                          (lambda (p)
                            (display '(hello) p)))
                        (call-with-output-file (assoc-ref %outputs "second")
                          (lambda (p)
                            (display '(world) p)))))
         (drv-path   (build-expression->derivation %store "double"
                                                   (%current-system)
                                                   builder '()
                                                   #:outputs '("out"
                                                               "second")))
         (succeeded? (build-derivations %store (list drv-path))))
    (and succeeded?
         (let ((one (derivation-path->output-path drv-path))
               (two (derivation-path->output-path drv-path "second")))
           (and (equal? '(hello) (call-with-input-file one read))
                (equal? '(world) (call-with-input-file two read)))))))

(test-skip (if %coreutils 0 1))
(test-assert "build-expression->derivation with one input"
  (let* ((builder    '(call-with-output-file %output
                        (lambda (p)
                          (let ((cu (assoc-ref %build-inputs "cu")))
                            (close 1)
                            (dup2 (port->fdes p) 1)
                            (execl (string-append cu "/bin/uname")
                                   "uname" "-a")))))
         (drv-path   (build-expression->derivation %store "uname" (%current-system)
                                                   builder
                                                   `(("cu" ,%coreutils))))
         (succeeded? (build-derivations %store (list drv-path))))
    (and succeeded?
         (let ((p (derivation-path->output-path drv-path)))
           (string-contains (call-with-input-file p read-line) "GNU")))))

(test-assert "imported-files"
  (let* ((files    `(("x"     . ,(search-path %load-path "ice-9/q.scm"))
                     ("a/b/c" . ,(search-path %load-path
                                              "guix/derivations.scm"))
                     ("p/q"   . ,(search-path %load-path "guix.scm"))
                     ("p/z"   . ,(search-path %load-path "guix/store.scm"))))
         (drv-path (imported-files %store files)))
    (and (build-derivations %store (list drv-path))
         (let ((dir (derivation-path->output-path drv-path)))
           (every (match-lambda
                   ((path . source)
                    (equal? (call-with-input-file (string-append dir "/" path)
                              get-bytevector-all)
                            (call-with-input-file source
                              get-bytevector-all))))
                  files)))))

(test-assert "build-expression->derivation with modules"
  (let* ((builder  `(begin
                      (use-modules (guix build utils))
                      (let ((out (assoc-ref %outputs "out")))
                        (mkdir-p (string-append out "/guile/guix/nix"))
                        #t)))
         (drv-path (build-expression->derivation %store
                                                 "test-with-modules"
                                                 (%current-system)
                                                 builder '()
                                                 #:modules
                                                 '((guix build utils)))))
    (and (build-derivations %store (list drv-path))
         (let* ((p (derivation-path->output-path drv-path))
                (s (stat (string-append p "/guile/guix/nix"))))
           (eq? (stat:type s) 'directory)))))

(test-assert "build-expression->derivation: same fixed-output path"
  (let* ((builder1   '(call-with-output-file %output
                        (lambda (p)
                          (write "hello" p))))
         (builder2   '(call-with-output-file (pk 'difference-here! %output)
                        (lambda (p)
                          (write "hello" p))))
         (hash       (sha256 (string->utf8 "hello")))
         (input1     (build-expression->derivation %store "fixed"
                                                   (%current-system)
                                                   builder1 '()
                                                   #:hash hash
                                                   #:hash-algo 'sha256))
         (input2     (build-expression->derivation %store "fixed"
                                                   (%current-system)
                                                   builder2 '()
                                                   #:hash hash
                                                   #:hash-algo 'sha256))
         (succeeded? (build-derivations %store (list input1 input2))))
    (and succeeded?
         (not (string=? input1 input2))
         (string=? (derivation-path->output-path input1)
                   (derivation-path->output-path input2)))))

(test-assert "build-expression->derivation with a fixed-output input"
  (let* ((builder1   '(call-with-output-file %output
                        (lambda (p)
                          (write "hello" p))))
         (builder2   '(call-with-output-file (pk 'difference-here! %output)
                        (lambda (p)
                          (write "hello" p))))
         (hash       (sha256 (string->utf8 "hello")))
         (input1     (build-expression->derivation %store "fixed"
                                                   (%current-system)
                                                   builder1 '()
                                                   #:hash hash
                                                   #:hash-algo 'sha256))
         (input2     (build-expression->derivation %store "fixed"
                                                   (%current-system)
                                                   builder2 '()
                                                   #:hash hash
                                                   #:hash-algo 'sha256))
         (builder3  '(let ((input (assoc-ref %build-inputs "input")))
                       (call-with-output-file %output
                         (lambda (out)
                           (format #f "My input is ~a.~%" input)))))
         (final1    (build-expression->derivation %store "final"
                                                  (%current-system)
                                                  builder3
                                                  `(("input" ,input1))))
         (final2    (build-expression->derivation %store "final"
                                                  (%current-system)
                                                  builder3
                                                  `(("input" ,input2)))))
    (and (string=? (derivation-path->output-path final1)
                   (derivation-path->output-path final2))
         (build-derivations %store (list final1 final2)))))

(test-end)

\f
(exit (= (test-runner-fail-count (test-runner-current)) 0))

;;; Local Variables:
;;; eval: (put 'test-assert 'scheme-indent-function 1)
;;; eval: (put 'guard 'scheme-indent-function 1)
;;; End:
Commit	Line	Data
233e7676 LC	1	;;; GNU Guix --- Functional package management for GNU
233e7676 LC	2	;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
341c6fdd	3	;;;
233e7676	4	;;; This file is part of GNU Guix.
341c6fdd	5	;;;
233e7676	6	;;; GNU Guix is free software; you can redistribute it and/or modify it
341c6fdd LC	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	;;;
233e7676	11	;;; GNU Guix is distributed in the hope that it will be useful, but
341c6fdd LC	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
233e7676	17	;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
341c6fdd LC	18
	19
	20	(define-module (test-derivations)
	21	#:use-module (guix derivations)
26bbbb95	22	#:use-module (guix store)
de4c3f26	23	#:use-module (guix utils)
ddc29a78	24	#:use-module (guix base32)
b272c474	25	#:use-module ((guix packages) #:select (package-derivation))
18633d4f	26	#:use-module (distro packages bootstrap)
b37eb5ed	27	#:use-module (srfi srfi-1)
fb3eec83	28	#:use-module (srfi srfi-11)
341c6fdd	29	#:use-module (srfi srfi-26)
99634e3f	30	#:use-module (srfi srfi-34)
341c6fdd	31	#:use-module (srfi srfi-64)
fb3eec83	32	#:use-module (rnrs io ports)
749c6567	33	#:use-module (rnrs bytevectors)
b37eb5ed	34	#:use-module (ice-9 rdelim)
db393b33	35	#:use-module (ice-9 regex)
99634e3f LC	36	#:use-module (ice-9 ftw)
99634e3f LC	37	#:use-module (ice-9 match))
341c6fdd	38
26bbbb95 LC	39	(define %store
	40	(false-if-exception (open-connection)))
	41
b272c474	42	(when %store
81dbd783 LC	43	;; Make sure we build everything by ourselves.
	44	(set-build-options %store #:use-substitutes? #f)
	45
b272c474 LC	46	;; By default, use %BOOTSTRAP-GUILE for the current system.
	47	(let ((drv (package-derivation %store %bootstrap-guile)))
	48	(%guile-for-build drv)))
	49
b37eb5ed LC	50	(define (directory-contents dir)
	51	"Return an alist representing the contents of DIR."
	52	(define prefix-len (string-length dir))
	53	(sort (file-system-fold (const #t) ; enter?
	54	(lambda (path stat result) ; leaf
	55	(alist-cons (string-drop path prefix-len)
	56	(call-with-input-file path
	57	get-bytevector-all)
	58	result))
	59	(lambda (path stat result) result) ; down
	60	(lambda (path stat result) result) ; up
	61	(lambda (path stat result) result) ; skip
	62	(lambda (path stat errno result) result) ; error
	63	'()
	64	dir)
	65	(lambda (e1 e2)
	66	(string<? (car e1) (car e2)))))
	67
341c6fdd LC	68	(test-begin "derivations")
	69
	70	(test-assert "parse & export"
33594aa4 LC	71	(let* ((f (search-path %load-path "tests/test.drv"))
33594aa4 LC	72	(b1 (call-with-input-file f get-bytevector-all))
341c6fdd LC	73	(d1 (read-derivation (open-bytevector-input-port b1)))
	74	(b2 (call-with-bytevector-output-port (cut write-derivation d1 <>)))
	75	(d2 (read-derivation (open-bytevector-input-port b2))))
	76	(and (equal? b1 b2)
	77	(equal? d1 d2))))
	78
29833b26	79	(test-skip (if %store 0 11))
b37eb5ed	80
d1b1c424 LC	81	(test-assert "add-to-store, flat"
	82	(let* ((file (search-path %load-path "language/tree-il/spec.scm"))
	83	(drv (add-to-store %store "flat-test" #t #f "sha256" file)))
	84	(and (eq? 'regular (stat:type (stat drv)))
31ef99a8	85	(valid-path? %store drv)
d1b1c424 LC	86	(equal? (call-with-input-file file get-bytevector-all)
	87	(call-with-input-file drv get-bytevector-all)))))
	88
b37eb5ed LC	89	(test-assert "add-to-store, recursive"
	90	(let* ((dir (dirname (search-path %load-path "language/tree-il/spec.scm")))
	91	(drv (add-to-store %store "dir-tree-test" #t #t "sha256" dir)))
	92	(and (eq? 'directory (stat:type (stat drv)))
31ef99a8	93	(valid-path? %store drv)
b37eb5ed LC	94	(equal? (directory-contents dir)
b37eb5ed LC	95	(directory-contents drv)))))
26bbbb95 LC	96
26bbbb95 LC	97	(test-assert "derivation with no inputs"
31ef99a8 LC	98	(let* ((builder (add-text-to-store %store "my-builder.sh"
	99	"#!/bin/sh\necho hello, world\n"
	100	'()))
	101	(drv-path (derivation %store "foo" (%current-system) builder
	102	'() '(("HOME" . "/homeless")) '())))
	103	(and (store-path? drv-path)
	104	(valid-path? %store drv-path))))
26bbbb95	105
fb3eec83 LC	106	(test-assert "build derivation with 1 source"
	107	(let*-values (((builder)
	108	(add-text-to-store %store "my-builder.sh"
de4c3f26	109	"echo hello, world > \"$out\"\n"
fb3eec83 LC	110	'()))
fb3eec83 LC	111	((drv-path drv)
98090557	112	(derivation %store "foo" (%current-system)
fb3eec83	113	"/bin/sh" `(,builder)
af7f9e5f LC	114	'(("HOME" . "/homeless")
	115	("zzz" . "Z!")
	116	("AAA" . "A!"))
fb3eec83 LC	117	`((,builder))))
	118	((succeeded?)
	119	(build-derivations %store (list drv-path))))
	120	(and succeeded?
	121	(let ((path (derivation-output-path
	122	(assoc-ref (derivation-outputs drv) "out"))))
31ef99a8 LC	123	(and (valid-path? %store path)
	124	(string=? (call-with-input-file path read-line)
	125	"hello, world"))))))
fb3eec83	126
860a6f1a LC	127	(test-assert "derivation with local file as input"
	128	(let* ((builder (add-text-to-store
	129	%store "my-builder.sh"
	130	"(while read line ; do echo $line ; done) < $in > $out"
	131	'()))
	132	(input (search-path %load-path "ice-9/boot-9.scm"))
	133	(drv-path (derivation %store "derivation-with-input-file"
	134	(%current-system)
	135	"/bin/sh" `(,builder)
	136	`(("in"
	137	;; Cheat to pass the actual file
	138	;; name to the builder.
	139	. ,(add-to-store %store
	140	(basename input)
	141	#t #t "sha256"
	142	input)))
	143	`((,builder)
	144	(,input))))) ; ← local file name
	145	(and (build-derivations %store (list drv-path))
	146	(let ((p (derivation-path->output-path drv-path)))
	147	(and (call-with-input-file p get-bytevector-all)
	148	(call-with-input-file input get-bytevector-all))))))
	149
749c6567 LC	150	(test-assert "fixed-output derivation"
	151	(let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
	152	"echo -n hello > $out" '()))
	153	(hash (sha256 (string->utf8 "hello")))
98090557	154	(drv-path (derivation %store "fixed" (%current-system)
749c6567	155	"/bin/sh" `(,builder)
813986ac LC	156	'()
813986ac LC	157	`((,builder)) ; optional
749c6567 LC	158	#:hash hash #:hash-algo 'sha256))
	159	(succeeded? (build-derivations %store (list drv-path))))
	160	(and succeeded?
	161	(let ((p (derivation-path->output-path drv-path)))
82058eff LC	162	(and (equal? (string->utf8 "hello")
	163	(call-with-input-file p get-bytevector-all))
	164	(bytevector? (query-path-hash %store p)))))))
749c6567	165
813986ac LC	166	(test-assert "fixed-output derivation: output paths are equal"
	167	(let* ((builder1 (add-text-to-store %store "fixed-builder1.sh"
	168	"echo -n hello > $out" '()))
	169	(builder2 (add-text-to-store %store "fixed-builder2.sh"
	170	"echo hey; echo -n hello > $out" '()))
	171	(hash (sha256 (string->utf8 "hello")))
	172	(drv-path1 (derivation %store "fixed" (%current-system)
	173	"/bin/sh" `(,builder1)
	174	'() `()
	175	#:hash hash #:hash-algo 'sha256))
	176	(drv-path2 (derivation %store "fixed" (%current-system)
	177	"/bin/sh" `(,builder2)
	178	'() `()
	179	#:hash hash #:hash-algo 'sha256))
	180	(succeeded? (build-derivations %store
	181	(list drv-path1 drv-path2))))
	182	(and succeeded?
	183	(equal? (derivation-path->output-path drv-path1)
	184	(derivation-path->output-path drv-path2)))))
	185
	186	(test-assert "derivation with a fixed-output input"
	187	;; A derivation D using a fixed-output derivation F doesn't has the same
	188	;; output path when passed F or F', as long as F and F' have the same output
	189	;; path.
	190	(let* ((builder1 (add-text-to-store %store "fixed-builder1.sh"
	191	"echo -n hello > $out" '()))
	192	(builder2 (add-text-to-store %store "fixed-builder2.sh"
	193	"echo hey; echo -n hello > $out" '()))
	194	(hash (sha256 (string->utf8 "hello")))
	195	(fixed1 (derivation %store "fixed" (%current-system)
	196	"/bin/sh" `(,builder1)
	197	'() `()
	198	#:hash hash #:hash-algo 'sha256))
	199	(fixed2 (derivation %store "fixed" (%current-system)
	200	"/bin/sh" `(,builder2)
	201	'() `()
	202	#:hash hash #:hash-algo 'sha256))
	203	(fixed-out (derivation-path->output-path fixed1))
	204	(builder3 (add-text-to-store
	205	%store "final-builder.sh"
	206	;; Use Bash hackery to avoid Coreutils.
	207	"echo $in ; (read -u 3 c; echo $c) 3< $in > $out" '()))
	208	(final1 (derivation %store "final" (%current-system)
	209	"/bin/sh" `(,builder3)
	210	`(("in" . ,fixed-out))
	211	`((,builder3) (,fixed1))))
	212	(final2 (derivation %store "final" (%current-system)
	213	"/bin/sh" `(,builder3)
	214	`(("in" . ,fixed-out))
	215	`((,builder3) (,fixed2))))
	216	(succeeded? (build-derivations %store
	217	(list final1 final2))))
	218	(and succeeded?
	219	(equal? (derivation-path->output-path final1)
	220	(derivation-path->output-path final2)))))
	221
7946c4e7 LC	222	(test-assert "multiple-output derivation"
	223	(let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
	224	"echo one > $out ; echo two > $second"
	225	'()))
98090557	226	(drv-path (derivation %store "fixed" (%current-system)
7946c4e7 LC	227	"/bin/sh" `(,builder)
	228	'(("HOME" . "/homeless")
	229	("zzz" . "Z!")
	230	("AAA" . "A!"))
	231	`((,builder))
	232	#:outputs '("out" "second")))
	233	(succeeded? (build-derivations %store (list drv-path))))
	234	(and succeeded?
	235	(let ((one (derivation-path->output-path drv-path "out"))
	236	(two (derivation-path->output-path drv-path "second")))
7244a5f7 LC	237	(and (lset= equal?
	238	(derivation-path->output-paths drv-path)
	239	`(("out" . ,one) ("second" . ,two)))
	240	(eq? 'one (call-with-input-file one read))
7946c4e7 LC	241	(eq? 'two (call-with-input-file two read)))))))
7946c4e7 LC	242
4b1786aa LC	243	(test-assert "multiple-output derivation, non-alphabetic order"
	244	;; Here, the outputs are not listed in alphabetic order. Yet, the store
	245	;; path computation must reorder them first.
	246	(let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
	247	"echo one > $out ; echo two > $AAA"
	248	'()))
	249	(drv-path (derivation %store "fixed" (%current-system)
	250	"/bin/sh" `(,builder)
	251	'()
	252	`((,builder))
	253	#:outputs '("out" "AAA")))
	254	(succeeded? (build-derivations %store (list drv-path))))
	255	(and succeeded?
	256	(let ((one (derivation-path->output-path drv-path "out"))
	257	(two (derivation-path->output-path drv-path "AAA")))
	258	(and (eq? 'one (call-with-input-file one read))
	259	(eq? 'two (call-with-input-file two read)))))))
	260
d66ac374 LC	261	(test-assert "user of multiple-output derivation"
	262	;; Check whether specifying several inputs coming from the same
	263	;; multiple-output derivation works.
	264	(let* ((builder1 (add-text-to-store %store "my-mo-builder.sh"
	265	"echo one > $out ; echo two > $two"
	266	'()))
	267	(mdrv (derivation %store "multiple-output" (%current-system)
	268	"/bin/sh" `(,builder1)
	269	'()
	270	`((,builder1))
	271	#:outputs '("out" "two")))
	272	(builder2 (add-text-to-store %store "my-mo-user-builder.sh"
	273	"read x < $one;
	274	read y < $two;
	275	echo \"($x $y)\" > $out"
	276	'()))
	277	(udrv (derivation %store "multiple-output-user"
	278	(%current-system)
	279	"/bin/sh" `(,builder2)
	280	`(("one" . ,(derivation-path->output-path
	281	mdrv "out"))
	282	("two" . ,(derivation-path->output-path
	283	mdrv "two")))
	284	`((,builder2)
	285	;; two occurrences of MDRV:
	286	(,mdrv)
	287	(,mdrv "two")))))
	288	(and (build-derivations %store (list (pk 'udrv udrv)))
	289	(let ((p (derivation-path->output-path udrv)))
	290	(and (valid-path? %store p)
	291	(equal? '(one two) (call-with-input-file p read)))))))
	292
de4c3f26 LC	293	\f
de4c3f26 LC	294	(define %coreutils
8f3ecbd7	295	(false-if-exception
ad1ebab3 LC	296	(and (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)
	297	(or (package-derivation %store %bootstrap-coreutils&co)
	298	(nixpkgs-derivation "coreutils")))))
de4c3f26 LC	299
	300	(test-skip (if %coreutils 0 1))
	301
	302	(test-assert "build derivation with coreutils"
	303	(let* ((builder
	304	(add-text-to-store %store "build-with-coreutils.sh"
	305	"echo $PATH ; mkdir --version ; mkdir $out ; touch $out/good"
	306	'()))
	307	(drv-path
98090557	308	(derivation %store "foo" (%current-system)
de4c3f26 LC	309	"/bin/sh" `(,builder)
	310	`(("PATH" .
	311	,(string-append
	312	(derivation-path->output-path %coreutils)
	313	"/bin")))
	314	`((,builder)
	315	(,%coreutils))))
	316	(succeeded?
	317	(build-derivations %store (list drv-path))))
	318	(and succeeded?
	319	(let ((p (derivation-path->output-path drv-path)))
31ef99a8 LC	320	(and (valid-path? %store p)
31ef99a8 LC	321	(file-exists? (string-append p "/good")))))))
de4c3f26	322
813986ac	323	(test-skip (if (%guile-for-build) 0 7))
9a20830e LC	324
	325	(test-assert "build-expression->derivation and derivation-prerequisites"
	326	(let-values (((drv-path drv)
	327	(build-expression->derivation %store "fail" (%current-system)
	328	#f '())))
	329	(any (match-lambda
	330	(($ <derivation-input> path)
	331	(string=? path (%guile-for-build))))
	332	(derivation-prerequisites drv))))
d9085c23 LC	333
	334	(test-assert "build-expression->derivation without inputs"
	335	(let* ((builder '(begin
	336	(mkdir %output)
	337	(call-with-output-file (string-append %output "/test")
	338	(lambda (p)
	339	(display '(hello guix) p)))))
98090557	340	(drv-path (build-expression->derivation %store "goo" (%current-system)
d9085c23 LC	341	builder '()))
	342	(succeeded? (build-derivations %store (list drv-path))))
	343	(and succeeded?
	344	(let ((p (derivation-path->output-path drv-path)))
	345	(equal? '(hello guix)
	346	(call-with-input-file (string-append p "/test") read))))))
	347
9a20830e LC	348	(test-assert "build-expression->derivation and derivation-prerequisites-to-build"
	349	(let-values (((drv-path drv)
	350	(build-expression->derivation %store "fail" (%current-system)
	351	#f '())))
	352	;; The only direct dependency is (%guile-for-build) and it's already
	353	;; built.
	354	(null? (derivation-prerequisites-to-build %store drv))))
	355
db393b33 LC	356	(test-assert "build-expression->derivation with expression returning #f"
	357	(let* ((builder '(begin
	358	(mkdir %output)
	359	#f)) ; fail!
	360	(drv-path (build-expression->derivation %store "fail" (%current-system)
31ef99a8 LC	361	builder '()))
31ef99a8 LC	362	(out-path (derivation-path->output-path drv-path)))
db393b33 LC	363	(guard (c ((nix-protocol-error? c)
	364	;; Note that the output path may exist at this point, but it
	365	;; is invalid.
31ef99a8 LC	366	(and (string-match "build .* failed"
	367	(nix-protocol-error-message c))
	368	(not (valid-path? %store out-path)))))
db393b33 LC	369	(build-derivations %store (list drv-path))
	370	#f)))
	371
9bc07f4d LC	372	(test-assert "build-expression->derivation with two outputs"
	373	(let* ((builder '(begin
	374	(call-with-output-file (assoc-ref %outputs "out")
	375	(lambda (p)
	376	(display '(hello) p)))
	377	(call-with-output-file (assoc-ref %outputs "second")
	378	(lambda (p)
	379	(display '(world) p)))))
	380	(drv-path (build-expression->derivation %store "double"
98090557	381	(%current-system)
9bc07f4d LC	382	builder '()
	383	#:outputs '("out"
	384	"second")))
	385	(succeeded? (build-derivations %store (list drv-path))))
	386	(and succeeded?
	387	(let ((one (derivation-path->output-path drv-path))
	388	(two (derivation-path->output-path drv-path "second")))
	389	(and (equal? '(hello) (call-with-input-file one read))
	390	(equal? '(world) (call-with-input-file two read)))))))
	391
ad1ebab3	392	(test-skip (if %coreutils 0 1))
d9085c23 LC	393	(test-assert "build-expression->derivation with one input"
	394	(let* ((builder '(call-with-output-file %output
	395	(lambda (p)
	396	(let ((cu (assoc-ref %build-inputs "cu")))
	397	(close 1)
	398	(dup2 (port->fdes p) 1)
	399	(execl (string-append cu "/bin/uname")
	400	"uname" "-a")))))
98090557	401	(drv-path (build-expression->derivation %store "uname" (%current-system)
d9085c23	402	builder
2acb2cb6	403	`(("cu" ,%coreutils))))
d9085c23 LC	404	(succeeded? (build-derivations %store (list drv-path))))
	405	(and succeeded?
	406	(let ((p (derivation-path->output-path drv-path)))
	407	(string-contains (call-with-input-file p read-line) "GNU")))))
	408
99634e3f LC	409	(test-assert "imported-files"
	410	(let* ((files `(("x" . ,(search-path %load-path "ice-9/q.scm"))
	411	("a/b/c" . ,(search-path %load-path
	412	"guix/derivations.scm"))
224f7ad6 LC	413	("p/q" . ,(search-path %load-path "guix.scm"))
224f7ad6 LC	414	("p/z" . ,(search-path %load-path "guix/store.scm"))))
99634e3f LC	415	(drv-path (imported-files %store files)))
	416	(and (build-derivations %store (list drv-path))
	417	(let ((dir (derivation-path->output-path drv-path)))
	418	(every (match-lambda
	419	((path . source)
	420	(equal? (call-with-input-file (string-append dir "/" path)
	421	get-bytevector-all)
	422	(call-with-input-file source
	423	get-bytevector-all))))
	424	files)))))
	425
d9024884 LC	426	(test-assert "build-expression->derivation with modules"
	427	(let* ((builder `(begin
	428	(use-modules (guix build utils))
	429	(let ((out (assoc-ref %outputs "out")))
	430	(mkdir-p (string-append out "/guile/guix/nix"))
	431	#t)))
	432	(drv-path (build-expression->derivation %store
	433	"test-with-modules"
	434	(%current-system)
	435	builder '()
	436	#:modules
	437	'((guix build utils)))))
	438	(and (build-derivations %store (list drv-path))
	439	(let* ((p (derivation-path->output-path drv-path))
	440	(s (stat (string-append p "/guile/guix/nix"))))
	441	(eq? (stat:type s) 'directory)))))
	442
813986ac LC	443	(test-assert "build-expression->derivation: same fixed-output path"
	444	(let* ((builder1 '(call-with-output-file %output
	445	(lambda (p)
	446	(write "hello" p))))
	447	(builder2 '(call-with-output-file (pk 'difference-here! %output)
	448	(lambda (p)
	449	(write "hello" p))))
	450	(hash (sha256 (string->utf8 "hello")))
	451	(input1 (build-expression->derivation %store "fixed"
	452	(%current-system)
	453	builder1 '()
	454	#:hash hash
	455	#:hash-algo 'sha256))
	456	(input2 (build-expression->derivation %store "fixed"
	457	(%current-system)
	458	builder2 '()
	459	#:hash hash
	460	#:hash-algo 'sha256))
	461	(succeeded? (build-derivations %store (list input1 input2))))
	462	(and succeeded?
	463	(not (string=? input1 input2))
	464	(string=? (derivation-path->output-path input1)
	465	(derivation-path->output-path input2)))))
	466
7bdd1f0e LC	467	(test-assert "build-expression->derivation with a fixed-output input"
	468	(let* ((builder1 '(call-with-output-file %output
	469	(lambda (p)
	470	(write "hello" p))))
	471	(builder2 '(call-with-output-file (pk 'difference-here! %output)
	472	(lambda (p)
	473	(write "hello" p))))
	474	(hash (sha256 (string->utf8 "hello")))
	475	(input1 (build-expression->derivation %store "fixed"
	476	(%current-system)
	477	builder1 '()
	478	#:hash hash
	479	#:hash-algo 'sha256))
	480	(input2 (build-expression->derivation %store "fixed"
	481	(%current-system)
	482	builder2 '()
	483	#:hash hash
	484	#:hash-algo 'sha256))
	485	(builder3 '(let ((input (assoc-ref %build-inputs "input")))
	486	(call-with-output-file %output
	487	(lambda (out)
	488	(format #f "My input is ~a.~%" input)))))
	489	(final1 (build-expression->derivation %store "final"
	490	(%current-system)
	491	builder3
	492	`(("input" ,input1))))
	493	(final2 (build-expression->derivation %store "final"
	494	(%current-system)
	495	builder3
	496	`(("input" ,input2)))))
	497	(and (string=? (derivation-path->output-path final1)
	498	(derivation-path->output-path final2))
	499	(build-derivations %store (list final1 final2)))))
	500
341c6fdd LC	501	(test-end)
	502
	503	\f
	504	(exit (= (test-runner-fail-count (test-runner-current)) 0))
	505
	506	;;; Local Variables:
	507	;;; eval: (put 'test-assert 'scheme-indent-function 1)
db393b33	508	;;; eval: (put 'guard 'scheme-indent-function 1)
341c6fdd	509	;;; End: