[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-11)
  #:use-module (srfi srfi-26)
  #:use-module (srfi srfi-64)
  #:use-module (rnrs io ports)
  #:use-module (rnrs bytevectors)
  #:use-module (ice-9 rdelim))

(define %current-system
  ;; System type as expected by Nix, usually ARCHITECTURE-KERNEL.
  "x86_64-linux")

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

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

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

(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"))))
           (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)))
           (equal? (string->utf8 "hello")
                   (call-with-input-file p get-bytevector-all))))))

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

\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)))
           (file-exists? (string-append p "/good"))))))

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

(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 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-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))
                         (let ((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)
;;; 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)
fb3eec83	24	#:use-module (srfi srfi-11)
341c6fdd LC	25	#:use-module (srfi srfi-26)
341c6fdd LC	26	#:use-module (srfi srfi-64)
fb3eec83	27	#:use-module (rnrs io ports)
749c6567	28	#:use-module (rnrs bytevectors)
fb3eec83	29	#:use-module (ice-9 rdelim))
341c6fdd	30
81095052 LC	31	(define %current-system
	32	;; System type as expected by Nix, usually ARCHITECTURE-KERNEL.
	33	"x86_64-linux")
	34
26bbbb95 LC	35	(define %store
	36	(false-if-exception (open-connection)))
	37
341c6fdd LC	38	(test-begin "derivations")
	39
	40	(test-assert "parse & export"
33594aa4 LC	41	(let* ((f (search-path %load-path "tests/test.drv"))
33594aa4 LC	42	(b1 (call-with-input-file f get-bytevector-all))
341c6fdd LC	43	(d1 (read-derivation (open-bytevector-input-port b1)))
	44	(b2 (call-with-bytevector-output-port (cut write-derivation d1 <>)))
	45	(d2 (read-derivation (open-bytevector-input-port b2))))
	46	(and (equal? b1 b2)
	47	(equal? d1 d2))))
	48
de4c3f26	49	(test-skip (if %store 0 3))
26bbbb95 LC	50
	51	(test-assert "derivation with no inputs"
	52	(let ((builder (add-text-to-store %store "my-builder.sh"
	53	"#!/bin/sh\necho hello, world\n"
	54	'())))
81095052	55	(store-path? (derivation %store "foo" %current-system builder
26bbbb95 LC	56	'() '(("HOME" . "/homeless")) '()))))
26bbbb95 LC	57
fb3eec83 LC	58	(test-assert "build derivation with 1 source"
	59	(let*-values (((builder)
	60	(add-text-to-store %store "my-builder.sh"
de4c3f26	61	"echo hello, world > \"$out\"\n"
fb3eec83 LC	62	'()))
fb3eec83 LC	63	((drv-path drv)
81095052	64	(derivation %store "foo" %current-system
fb3eec83	65	"/bin/sh" `(,builder)
af7f9e5f LC	66	'(("HOME" . "/homeless")
	67	("zzz" . "Z!")
	68	("AAA" . "A!"))
fb3eec83 LC	69	`((,builder))))
	70	((succeeded?)
	71	(build-derivations %store (list drv-path))))
	72	(and succeeded?
	73	(let ((path (derivation-output-path
	74	(assoc-ref (derivation-outputs drv) "out"))))
	75	(string=? (call-with-input-file path read-line)
	76	"hello, world")))))
	77
749c6567 LC	78	(test-assert "fixed-output derivation"
	79	(let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
	80	"echo -n hello > $out" '()))
	81	(hash (sha256 (string->utf8 "hello")))
81095052	82	(drv-path (derivation %store "fixed" %current-system
749c6567 LC	83	"/bin/sh" `(,builder)
	84	'() `((,builder))
	85	#:hash hash #:hash-algo 'sha256))
	86	(succeeded? (build-derivations %store (list drv-path))))
	87	(and succeeded?
	88	(let ((p (derivation-path->output-path drv-path)))
	89	(equal? (string->utf8 "hello")
	90	(call-with-input-file p get-bytevector-all))))))
	91
7946c4e7 LC	92	(test-assert "multiple-output derivation"
	93	(let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
	94	"echo one > $out ; echo two > $second"
	95	'()))
81095052	96	(drv-path (derivation %store "fixed" %current-system
7946c4e7 LC	97	"/bin/sh" `(,builder)
	98	'(("HOME" . "/homeless")
	99	("zzz" . "Z!")
	100	("AAA" . "A!"))
	101	`((,builder))
	102	#:outputs '("out" "second")))
	103	(succeeded? (build-derivations %store (list drv-path))))
	104	(and succeeded?
	105	(let ((one (derivation-path->output-path drv-path "out"))
	106	(two (derivation-path->output-path drv-path "second")))
	107	(and (eq? 'one (call-with-input-file one read))
	108	(eq? 'two (call-with-input-file two read)))))))
	109
de4c3f26 LC	110	\f
	111	(define %coreutils
	112	(false-if-exception (nixpkgs-derivation "coreutils")))
	113
	114	(test-skip (if %coreutils 0 1))
	115
	116	(test-assert "build derivation with coreutils"
	117	(let* ((builder
	118	(add-text-to-store %store "build-with-coreutils.sh"
	119	"echo $PATH ; mkdir --version ; mkdir $out ; touch $out/good"
	120	'()))
	121	(drv-path
81095052	122	(derivation %store "foo" %current-system
de4c3f26 LC	123	"/bin/sh" `(,builder)
	124	`(("PATH" .
	125	,(string-append
	126	(derivation-path->output-path %coreutils)
	127	"/bin")))
	128	`((,builder)
	129	(,%coreutils))))
	130	(succeeded?
	131	(build-derivations %store (list drv-path))))
	132	(and succeeded?
	133	(let ((p (derivation-path->output-path drv-path)))
	134	(file-exists? (string-append p "/good"))))))
	135
d9085c23 LC	136	(test-skip (if (%guile-for-build) 0 2))
	137
	138	(test-assert "build-expression->derivation without inputs"
	139	(let* ((builder '(begin
	140	(mkdir %output)
	141	(call-with-output-file (string-append %output "/test")
	142	(lambda (p)
	143	(display '(hello guix) p)))))
81095052	144	(drv-path (build-expression->derivation %store "goo" %current-system
d9085c23 LC	145	builder '()))
	146	(succeeded? (build-derivations %store (list drv-path))))
	147	(and succeeded?
	148	(let ((p (derivation-path->output-path drv-path)))
	149	(equal? '(hello guix)
	150	(call-with-input-file (string-append p "/test") read))))))
	151
9bc07f4d LC	152	(test-assert "build-expression->derivation with two outputs"
	153	(let* ((builder '(begin
	154	(call-with-output-file (assoc-ref %outputs "out")
	155	(lambda (p)
	156	(display '(hello) p)))
	157	(call-with-output-file (assoc-ref %outputs "second")
	158	(lambda (p)
	159	(display '(world) p)))))
	160	(drv-path (build-expression->derivation %store "double"
81095052	161	%current-system
9bc07f4d LC	162	builder '()
	163	#:outputs '("out"
	164	"second")))
	165	(succeeded? (build-derivations %store (list drv-path))))
	166	(and succeeded?
	167	(let ((one (derivation-path->output-path drv-path))
	168	(two (derivation-path->output-path drv-path "second")))
	169	(and (equal? '(hello) (call-with-input-file one read))
	170	(equal? '(world) (call-with-input-file two read)))))))
	171
d9085c23 LC	172	(test-assert "build-expression->derivation with one input"
	173	(let* ((builder '(call-with-output-file %output
	174	(lambda (p)
	175	(let ((cu (assoc-ref %build-inputs "cu")))
	176	(close 1)
	177	(dup2 (port->fdes p) 1)
	178	(execl (string-append cu "/bin/uname")
	179	"uname" "-a")))))
81095052	180	(drv-path (build-expression->derivation %store "uname" %current-system
d9085c23 LC	181	builder
	182	`(("cu" . ,%coreutils))))
	183	(succeeded? (build-derivations %store (list drv-path))))
	184	(and succeeded?
	185	(let ((p (derivation-path->output-path drv-path)))
	186	(string-contains (call-with-input-file p read-line) "GNU")))))
	187
26b969de LC	188	(test-skip (if (false-if-exception (getaddrinfo "ftp.gnu.org" "http"))
	189	0
	190	1))
	191
	192	(test-assert "build-expression->derivation for fixed-output derivation"
	193	(let* ((url "http://ftp.gnu.org/gnu/hello/hello-2.8.tar.gz")
	194	(builder `(begin
	195	(use-modules (web client) (web uri)
	196	(rnrs io ports))
	197	(let ((bv (http-get (string->uri ,url)
	198	#:decode-body? #f)))
	199	(call-with-output-file %output
	200	(lambda (p)
	201	(put-bytevector p bv))))))
	202	(drv-path (build-expression->derivation
81095052	203	%store "hello-2.8.tar.gz" %current-system builder '()
26b969de LC	204	#:hash (nix-base32-string->bytevector
	205	"0wqd8sjmxfskrflaxywc7gqw7sfawrfvdxd9skxawzfgyy0pzdz6")
	206	#:hash-algo 'sha256))
	207	(succeeded? (build-derivations %store (list drv-path))))
	208	(and succeeded?
	209	(file-exists? (derivation-path->output-path drv-path)))))
	210
341c6fdd LC	211	(test-end)
	212
	213	\f
	214	(exit (= (test-runner-fail-count (test-runner-current)) 0))
	215
	216	;;; Local Variables:
	217	;;; eval: (put 'test-assert 'scheme-indent-function 1)
	218	;;; End: