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

;;; Guix --- Nix package management from Guile.         -*- coding: utf-8 -*-
;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of Guix.
;;;
;;; 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.
;;;
;;; 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 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 (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)))

(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 4))

(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 "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))
                                 #: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 "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 (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 (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 6))

(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-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-skip (if (false-if-exception (getaddrinfo "ftp.gnu.org" "http"))
               0
               1))

(test-assert "build-expression->derivation for fixed-output derivation"
  (let* ((url         "http://ftp.gnu.org/gnu/hello/hello-2.8.tar.gz")
         (builder
          `(begin
             (use-modules (web client) (web uri)
                          (rnrs io ports) (srfi srfi-11))
             (let-values (((resp bv)
                           (http-get (string->uri ,url) #:decode-body? #f)))
               (call-with-output-file %output
                 (lambda (p)
                   (put-bytevector p bv))))))
         (drv-path    (build-expression->derivation
                       %store "hello-2.8.tar.gz" (%current-system) builder '()
                       #:hash (nix-base32-string->bytevector
                               "0wqd8sjmxfskrflaxywc7gqw7sfawrfvdxd9skxawzfgyy0pzdz6")
                       #:hash-algo 'sha256))
         (succeeded?  (build-derivations %store (list drv-path))))
    (and succeeded?
         (file-exists? (derivation-path->output-path drv-path)))))

(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
341c6fdd LC	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
	19
	20	(define-module (test-derivations)
	21	#:use-module (guix derivations)
26bbbb95	22	#:use-module (guix store)
de4c3f26	23	#:use-module (guix utils)
b37eb5ed	24	#:use-module (srfi srfi-1)
fb3eec83	25	#:use-module (srfi srfi-11)
341c6fdd	26	#:use-module (srfi srfi-26)
99634e3f	27	#:use-module (srfi srfi-34)
341c6fdd	28	#:use-module (srfi srfi-64)
fb3eec83	29	#:use-module (rnrs io ports)
749c6567	30	#:use-module (rnrs bytevectors)
b37eb5ed	31	#:use-module (ice-9 rdelim)
db393b33	32	#:use-module (ice-9 regex)
99634e3f LC	33	#:use-module (ice-9 ftw)
99634e3f LC	34	#:use-module (ice-9 match))
341c6fdd	35
26bbbb95 LC	36	(define %store
	37	(false-if-exception (open-connection)))
	38
b37eb5ed LC	39	(define (directory-contents dir)
	40	"Return an alist representing the contents of DIR."
	41	(define prefix-len (string-length dir))
	42	(sort (file-system-fold (const #t) ; enter?
	43	(lambda (path stat result) ; leaf
	44	(alist-cons (string-drop path prefix-len)
	45	(call-with-input-file path
	46	get-bytevector-all)
	47	result))
	48	(lambda (path stat result) result) ; down
	49	(lambda (path stat result) result) ; up
	50	(lambda (path stat result) result) ; skip
	51	(lambda (path stat errno result) result) ; error
	52	'()
	53	dir)
	54	(lambda (e1 e2)
	55	(string<? (car e1) (car e2)))))
	56
341c6fdd LC	57	(test-begin "derivations")
	58
	59	(test-assert "parse & export"
33594aa4 LC	60	(let* ((f (search-path %load-path "tests/test.drv"))
33594aa4 LC	61	(b1 (call-with-input-file f get-bytevector-all))
341c6fdd LC	62	(d1 (read-derivation (open-bytevector-input-port b1)))
	63	(b2 (call-with-bytevector-output-port (cut write-derivation d1 <>)))
	64	(d2 (read-derivation (open-bytevector-input-port b2))))
	65	(and (equal? b1 b2)
	66	(equal? d1 d2))))
	67
b37eb5ed LC	68	(test-skip (if %store 0 4))
b37eb5ed LC	69
d1b1c424 LC	70	(test-assert "add-to-store, flat"
	71	(let* ((file (search-path %load-path "language/tree-il/spec.scm"))
	72	(drv (add-to-store %store "flat-test" #t #f "sha256" file)))
	73	(and (eq? 'regular (stat:type (stat drv)))
31ef99a8	74	(valid-path? %store drv)
d1b1c424 LC	75	(equal? (call-with-input-file file get-bytevector-all)
	76	(call-with-input-file drv get-bytevector-all)))))
	77
b37eb5ed LC	78	(test-assert "add-to-store, recursive"
	79	(let* ((dir (dirname (search-path %load-path "language/tree-il/spec.scm")))
	80	(drv (add-to-store %store "dir-tree-test" #t #t "sha256" dir)))
	81	(and (eq? 'directory (stat:type (stat drv)))
31ef99a8	82	(valid-path? %store drv)
b37eb5ed LC	83	(equal? (directory-contents dir)
b37eb5ed LC	84	(directory-contents drv)))))
26bbbb95 LC	85
26bbbb95 LC	86	(test-assert "derivation with no inputs"
31ef99a8 LC	87	(let* ((builder (add-text-to-store %store "my-builder.sh"
	88	"#!/bin/sh\necho hello, world\n"
	89	'()))
	90	(drv-path (derivation %store "foo" (%current-system) builder
	91	'() '(("HOME" . "/homeless")) '())))
	92	(and (store-path? drv-path)
	93	(valid-path? %store drv-path))))
26bbbb95	94
fb3eec83 LC	95	(test-assert "build derivation with 1 source"
	96	(let*-values (((builder)
	97	(add-text-to-store %store "my-builder.sh"
de4c3f26	98	"echo hello, world > \"$out\"\n"
fb3eec83 LC	99	'()))
fb3eec83 LC	100	((drv-path drv)
98090557	101	(derivation %store "foo" (%current-system)
fb3eec83	102	"/bin/sh" `(,builder)
af7f9e5f LC	103	'(("HOME" . "/homeless")
	104	("zzz" . "Z!")
	105	("AAA" . "A!"))
fb3eec83 LC	106	`((,builder))))
	107	((succeeded?)
	108	(build-derivations %store (list drv-path))))
	109	(and succeeded?
	110	(let ((path (derivation-output-path
	111	(assoc-ref (derivation-outputs drv) "out"))))
31ef99a8 LC	112	(and (valid-path? %store path)
	113	(string=? (call-with-input-file path read-line)
	114	"hello, world"))))))
fb3eec83	115
749c6567 LC	116	(test-assert "fixed-output derivation"
	117	(let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
	118	"echo -n hello > $out" '()))
	119	(hash (sha256 (string->utf8 "hello")))
98090557	120	(drv-path (derivation %store "fixed" (%current-system)
749c6567 LC	121	"/bin/sh" `(,builder)
	122	'() `((,builder))
	123	#:hash hash #:hash-algo 'sha256))
	124	(succeeded? (build-derivations %store (list drv-path))))
	125	(and succeeded?
	126	(let ((p (derivation-path->output-path drv-path)))
82058eff LC	127	(and (equal? (string->utf8 "hello")
	128	(call-with-input-file p get-bytevector-all))
	129	(bytevector? (query-path-hash %store p)))))))
749c6567	130
7946c4e7 LC	131	(test-assert "multiple-output derivation"
	132	(let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
	133	"echo one > $out ; echo two > $second"
	134	'()))
98090557	135	(drv-path (derivation %store "fixed" (%current-system)
7946c4e7 LC	136	"/bin/sh" `(,builder)
	137	'(("HOME" . "/homeless")
	138	("zzz" . "Z!")
	139	("AAA" . "A!"))
	140	`((,builder))
	141	#:outputs '("out" "second")))
	142	(succeeded? (build-derivations %store (list drv-path))))
	143	(and succeeded?
	144	(let ((one (derivation-path->output-path drv-path "out"))
	145	(two (derivation-path->output-path drv-path "second")))
	146	(and (eq? 'one (call-with-input-file one read))
	147	(eq? 'two (call-with-input-file two read)))))))
	148
4b1786aa LC	149	(test-assert "multiple-output derivation, non-alphabetic order"
	150	;; Here, the outputs are not listed in alphabetic order. Yet, the store
	151	;; path computation must reorder them first.
	152	(let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
	153	"echo one > $out ; echo two > $AAA"
	154	'()))
	155	(drv-path (derivation %store "fixed" (%current-system)
	156	"/bin/sh" `(,builder)
	157	'()
	158	`((,builder))
	159	#:outputs '("out" "AAA")))
	160	(succeeded? (build-derivations %store (list drv-path))))
	161	(and succeeded?
	162	(let ((one (derivation-path->output-path drv-path "out"))
	163	(two (derivation-path->output-path drv-path "AAA")))
	164	(and (eq? 'one (call-with-input-file one read))
	165	(eq? 'two (call-with-input-file two read)))))))
	166
d66ac374 LC	167	(test-assert "user of multiple-output derivation"
	168	;; Check whether specifying several inputs coming from the same
	169	;; multiple-output derivation works.
	170	(let* ((builder1 (add-text-to-store %store "my-mo-builder.sh"
	171	"echo one > $out ; echo two > $two"
	172	'()))
	173	(mdrv (derivation %store "multiple-output" (%current-system)
	174	"/bin/sh" `(,builder1)
	175	'()
	176	`((,builder1))
	177	#:outputs '("out" "two")))
	178	(builder2 (add-text-to-store %store "my-mo-user-builder.sh"
	179	"read x < $one;
	180	read y < $two;
	181	echo \"($x $y)\" > $out"
	182	'()))
	183	(udrv (derivation %store "multiple-output-user"
	184	(%current-system)
	185	"/bin/sh" `(,builder2)
	186	`(("one" . ,(derivation-path->output-path
	187	mdrv "out"))
	188	("two" . ,(derivation-path->output-path
	189	mdrv "two")))
	190	`((,builder2)
	191	;; two occurrences of MDRV:
	192	(,mdrv)
	193	(,mdrv "two")))))
	194	(and (build-derivations %store (list (pk 'udrv udrv)))
	195	(let ((p (derivation-path->output-path udrv)))
	196	(and (valid-path? %store p)
	197	(equal? '(one two) (call-with-input-file p read)))))))
	198
de4c3f26 LC	199	\f
	200	(define %coreutils
	201	(false-if-exception (nixpkgs-derivation "coreutils")))
	202
	203	(test-skip (if %coreutils 0 1))
	204
	205	(test-assert "build derivation with coreutils"
	206	(let* ((builder
	207	(add-text-to-store %store "build-with-coreutils.sh"
	208	"echo $PATH ; mkdir --version ; mkdir $out ; touch $out/good"
	209	'()))
	210	(drv-path
98090557	211	(derivation %store "foo" (%current-system)
de4c3f26 LC	212	"/bin/sh" `(,builder)
	213	`(("PATH" .
	214	,(string-append
	215	(derivation-path->output-path %coreutils)
	216	"/bin")))
	217	`((,builder)
	218	(,%coreutils))))
	219	(succeeded?
	220	(build-derivations %store (list drv-path))))
	221	(and succeeded?
	222	(let ((p (derivation-path->output-path drv-path)))
31ef99a8 LC	223	(and (valid-path? %store p)
31ef99a8 LC	224	(file-exists? (string-append p "/good")))))))
de4c3f26	225
9a20830e LC	226	(test-skip (if (%guile-for-build) 0 6))
	227
	228	(test-assert "build-expression->derivation and derivation-prerequisites"
	229	(let-values (((drv-path drv)
	230	(build-expression->derivation %store "fail" (%current-system)
	231	#f '())))
	232	(any (match-lambda
	233	(($ <derivation-input> path)
	234	(string=? path (%guile-for-build))))
	235	(derivation-prerequisites drv))))
d9085c23 LC	236
	237	(test-assert "build-expression->derivation without inputs"
	238	(let* ((builder '(begin
	239	(mkdir %output)
	240	(call-with-output-file (string-append %output "/test")
	241	(lambda (p)
	242	(display '(hello guix) p)))))
98090557	243	(drv-path (build-expression->derivation %store "goo" (%current-system)
d9085c23 LC	244	builder '()))
	245	(succeeded? (build-derivations %store (list drv-path))))
	246	(and succeeded?
	247	(let ((p (derivation-path->output-path drv-path)))
	248	(equal? '(hello guix)
	249	(call-with-input-file (string-append p "/test") read))))))
	250
9a20830e LC	251	(test-assert "build-expression->derivation and derivation-prerequisites-to-build"
	252	(let-values (((drv-path drv)
	253	(build-expression->derivation %store "fail" (%current-system)
	254	#f '())))
	255	;; The only direct dependency is (%guile-for-build) and it's already
	256	;; built.
	257	(null? (derivation-prerequisites-to-build %store drv))))
	258
db393b33 LC	259	(test-assert "build-expression->derivation with expression returning #f"
	260	(let* ((builder '(begin
	261	(mkdir %output)
	262	#f)) ; fail!
	263	(drv-path (build-expression->derivation %store "fail" (%current-system)
31ef99a8 LC	264	builder '()))
31ef99a8 LC	265	(out-path (derivation-path->output-path drv-path)))
db393b33 LC	266	(guard (c ((nix-protocol-error? c)
	267	;; Note that the output path may exist at this point, but it
	268	;; is invalid.
31ef99a8 LC	269	(and (string-match "build .* failed"
	270	(nix-protocol-error-message c))
	271	(not (valid-path? %store out-path)))))
db393b33 LC	272	(build-derivations %store (list drv-path))
	273	#f)))
	274
9bc07f4d LC	275	(test-assert "build-expression->derivation with two outputs"
	276	(let* ((builder '(begin
	277	(call-with-output-file (assoc-ref %outputs "out")
	278	(lambda (p)
	279	(display '(hello) p)))
	280	(call-with-output-file (assoc-ref %outputs "second")
	281	(lambda (p)
	282	(display '(world) p)))))
	283	(drv-path (build-expression->derivation %store "double"
98090557	284	(%current-system)
9bc07f4d LC	285	builder '()
	286	#:outputs '("out"
	287	"second")))
	288	(succeeded? (build-derivations %store (list drv-path))))
	289	(and succeeded?
	290	(let ((one (derivation-path->output-path drv-path))
	291	(two (derivation-path->output-path drv-path "second")))
	292	(and (equal? '(hello) (call-with-input-file one read))
	293	(equal? '(world) (call-with-input-file two read)))))))
	294
d9085c23 LC	295	(test-assert "build-expression->derivation with one input"
	296	(let* ((builder '(call-with-output-file %output
	297	(lambda (p)
	298	(let ((cu (assoc-ref %build-inputs "cu")))
	299	(close 1)
	300	(dup2 (port->fdes p) 1)
	301	(execl (string-append cu "/bin/uname")
	302	"uname" "-a")))))
98090557	303	(drv-path (build-expression->derivation %store "uname" (%current-system)
d9085c23	304	builder
2acb2cb6	305	`(("cu" ,%coreutils))))
d9085c23 LC	306	(succeeded? (build-derivations %store (list drv-path))))
	307	(and succeeded?
	308	(let ((p (derivation-path->output-path drv-path)))
	309	(string-contains (call-with-input-file p read-line) "GNU")))))
	310
99634e3f LC	311	(test-assert "imported-files"
	312	(let* ((files `(("x" . ,(search-path %load-path "ice-9/q.scm"))
	313	("a/b/c" . ,(search-path %load-path
	314	"guix/derivations.scm"))
224f7ad6 LC	315	("p/q" . ,(search-path %load-path "guix.scm"))
224f7ad6 LC	316	("p/z" . ,(search-path %load-path "guix/store.scm"))))
99634e3f LC	317	(drv-path (imported-files %store files)))
	318	(and (build-derivations %store (list drv-path))
	319	(let ((dir (derivation-path->output-path drv-path)))
	320	(every (match-lambda
	321	((path . source)
	322	(equal? (call-with-input-file (string-append dir "/" path)
	323	get-bytevector-all)
	324	(call-with-input-file source
	325	get-bytevector-all))))
	326	files)))))
	327
d9024884 LC	328	(test-assert "build-expression->derivation with modules"
	329	(let* ((builder `(begin
	330	(use-modules (guix build utils))
	331	(let ((out (assoc-ref %outputs "out")))
	332	(mkdir-p (string-append out "/guile/guix/nix"))
	333	#t)))
	334	(drv-path (build-expression->derivation %store
	335	"test-with-modules"
	336	(%current-system)
	337	builder '()
	338	#:modules
	339	'((guix build utils)))))
	340	(and (build-derivations %store (list drv-path))
	341	(let* ((p (derivation-path->output-path drv-path))
	342	(s (stat (string-append p "/guile/guix/nix"))))
	343	(eq? (stat:type s) 'directory)))))
	344
26b969de LC	345	(test-skip (if (false-if-exception (getaddrinfo "ftp.gnu.org" "http"))
	346	0
	347	1))
	348
	349	(test-assert "build-expression->derivation for fixed-output derivation"
	350	(let* ((url "http://ftp.gnu.org/gnu/hello/hello-2.8.tar.gz")
0e383c76 LC	351	(builder
	352	`(begin
	353	(use-modules (web client) (web uri)
	354	(rnrs io ports) (srfi srfi-11))
	355	(let-values (((resp bv)
	356	(http-get (string->uri ,url) #:decode-body? #f)))
	357	(call-with-output-file %output
	358	(lambda (p)
	359	(put-bytevector p bv))))))
26b969de	360	(drv-path (build-expression->derivation
98090557	361	%store "hello-2.8.tar.gz" (%current-system) builder '()
26b969de LC	362	#:hash (nix-base32-string->bytevector
	363	"0wqd8sjmxfskrflaxywc7gqw7sfawrfvdxd9skxawzfgyy0pzdz6")
	364	#:hash-algo 'sha256))
	365	(succeeded? (build-derivations %store (list drv-path))))
	366	(and succeeded?
	367	(file-exists? (derivation-path->output-path drv-path)))))
	368
341c6fdd LC	369	(test-end)
	370
	371	\f
	372	(exit (= (test-runner-fail-count (test-runner-current)) 0))
	373
	374	;;; Local Variables:
	375	;;; eval: (put 'test-assert 'scheme-indent-function 1)
db393b33	376	;;; eval: (put 'guard 'scheme-indent-function 1)
341c6fdd	377	;;; End: