-;;; Guix --- Nix package management from Guile. -*- coding: utf-8 -*-
-;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org>
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;;
-;;; This file is part of Guix.
+;;; This file is part of GNU Guix.
;;;
-;;; Guix is free software; you can redistribute it and/or modify it
+;;; 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.
;;;
-;;; Guix is distributed in the hope that it will be useful, but
+;;; 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 Guix. If not, see <http://www.gnu.org/licenses/>.
+;;; 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 ((gnu packages) #:select (search-bootstrap-binary))
+ #:use-module (gnu packages bootstrap)
#:use-module (srfi srfi-1)
#: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 (web uri)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 regex)
#:use-module (ice-9 ftw)
(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 %bash
+ (let ((bash (search-bootstrap-binary "bash" (%current-system))))
+ (and %store
+ (add-to-store %store "bash" #t "sha256" bash))))
+
(define (directory-contents dir)
"Return an alist representing the contents of DIR."
(define prefix-len (string-length dir))
(and (equal? b1 b2)
(equal? d1 d2))))
-(test-skip (if %store 0 4))
+(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)))
+ (drv (add-to-store %store "flat-test" #f "sha256" file)))
(and (eq? 'regular (stat:type (stat drv)))
(valid-path? %store drv)
(equal? (call-with-input-file file 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)))
+ (drv (add-to-store %store "dir-tree-test" #t "sha256" dir)))
(and (eq? 'directory (stat:type (stat drv)))
(valid-path? %store drv)
(equal? (directory-contents dir)
(test-assert "derivation with no inputs"
(let* ((builder (add-text-to-store %store "my-builder.sh"
- "#!/bin/sh\necho hello, world\n"
+ "echo hello, world\n"
'()))
- (drv-path (derivation %store "foo" (%current-system) builder
- '() '(("HOME" . "/homeless")) '())))
+ (drv-path (derivation %store "foo" (%current-system)
+ %bash `("-e" ,builder)
+ '(("HOME" . "/homeless")) '())))
(and (store-path? drv-path)
(valid-path? %store drv-path))))
'()))
((drv-path drv)
(derivation %store "foo" (%current-system)
- "/bin/sh" `(,builder)
+ %bash `(,builder)
'(("HOME" . "/homeless")
("zzz" . "Z!")
("AAA" . "A!"))
(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)
+ %bash `(,builder)
+ `(("in"
+ ;; Cheat to pass the actual file
+ ;; name to the builder.
+ . ,(add-to-store %store
+ (basename input)
+ #t "sha256"
+ input)))
+ `((,builder)
+ (,input))))) ; ← local file name
+ (and (build-derivations %store (list drv-path))
+ ;; Note: we can't compare the files because the above trick alters
+ ;; the contents.
+ (valid-path? %store (derivation-path->output-path drv-path)))))
+
(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))
+ %bash `(,builder)
+ '()
+ `((,builder)) ; optional
#:hash hash #:hash-algo 'sha256))
(succeeded? (build-derivations %store (list drv-path))))
(and succeeded?
(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)
+ %bash `(,builder1)
+ '() `()
+ #:hash hash #:hash-algo 'sha256))
+ (drv-path2 (derivation %store "fixed" (%current-system)
+ %bash `(,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)
+ %bash `(,builder1)
+ '() `()
+ #:hash hash #:hash-algo 'sha256))
+ (fixed2 (derivation %store "fixed" (%current-system)
+ %bash `(,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)
+ %bash `(,builder3)
+ `(("in" . ,fixed-out))
+ `((,builder3) (,fixed1))))
+ (final2 (derivation %store "final" (%current-system)
+ %bash `(,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)
+ %bash `(,builder)
'(("HOME" . "/homeless")
("zzz" . "Z!")
("AAA" . "A!"))
(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))
+ (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"
"echo one > $out ; echo two > $AAA"
'()))
(drv-path (derivation %store "fixed" (%current-system)
- "/bin/sh" `(,builder)
+ %bash `(,builder)
'()
`((,builder))
#:outputs '("out" "AAA")))
"echo one > $out ; echo two > $two"
'()))
(mdrv (derivation %store "multiple-output" (%current-system)
- "/bin/sh" `(,builder1)
+ %bash `(,builder1)
'()
`((,builder1))
#:outputs '("out" "two")))
'()))
(udrv (derivation %store "multiple-output-user"
(%current-system)
- "/bin/sh" `(,builder2)
+ %bash `(,builder2)
`(("one" . ,(derivation-path->output-path
mdrv "out"))
("two" . ,(derivation-path->output-path
\f
(define %coreutils
- (false-if-exception (nixpkgs-derivation "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))
'()))
(drv-path
(derivation %store "foo" (%current-system)
- "/bin/sh" `(,builder)
+ %bash `(,builder)
`(("PATH" .
,(string-append
(derivation-path->output-path %coreutils)
(and (valid-path? %store p)
(file-exists? (string-append p "/good")))))))
-(test-skip (if (%guile-for-build) 0 6))
+(test-skip (if (%guile-for-build) 0 7))
(test-assert "build-expression->derivation and derivation-prerequisites"
(let-values (((drv-path drv)
;; built.
(null? (derivation-prerequisites-to-build %store drv))))
+(test-assert "derivation-prerequisites-to-build when outputs already present"
+ (let*-values (((builder)
+ '(begin (mkdir %output) #t))
+ ((input-drv-path input-drv)
+ (build-expression->derivation %store "input"
+ (%current-system)
+ builder '()))
+ ((input-path)
+ (derivation-output-path
+ (assoc-ref (derivation-outputs input-drv)
+ "out")))
+ ((drv-path drv)
+ (build-expression->derivation %store "something"
+ (%current-system)
+ builder
+ `(("i" ,input-drv-path))))
+ ((output)
+ (derivation-output-path
+ (assoc-ref (derivation-outputs drv) "out"))))
+ ;; Make sure these things are not already built.
+ (when (valid-path? %store input-path)
+ (delete-paths %store (list input-path)))
+ (when (valid-path? %store output)
+ (delete-paths %store (list output)))
+
+ (and (equal? (map derivation-input-path
+ (derivation-prerequisites-to-build %store drv))
+ (list input-drv-path))
+
+ ;; Build DRV and delete its input.
+ (build-derivations %store (list drv-path))
+ (delete-paths %store (list input-path))
+ (not (valid-path? %store input-path))
+
+ ;; Now INPUT-PATH is missing, yet it shouldn't be listed as a
+ ;; prerequisite to build because DRV itself is already built.
+ (null? (derivation-prerequisites-to-build %store drv)))))
+
+(test-skip (if (getenv "GUIX_BINARY_SUBSTITUTE_URL") 0 1))
+(test-assert "derivation-prerequisites-to-build and substitutes"
+ (let*-values (((store)
+ (open-connection))
+ ((drv-path drv)
+ (build-expression->derivation store "prereq-subst"
+ (%current-system)
+ (random 1000) '()))
+ ((output)
+ (derivation-output-path
+ (assoc-ref (derivation-outputs drv) "out")))
+ ((dir)
+ (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL")
+ (compose uri-path string->uri))))
+ ;; Create fake substituter data, to be read by `substitute-binary'.
+ (call-with-output-file (string-append dir "/nix-cache-info")
+ (lambda (p)
+ (format p "StoreDir: ~a\nWantMassQuery: 0\n"
+ (%store-prefix))))
+ (call-with-output-file (string-append dir "/" (store-path-hash-part output)
+ ".narinfo")
+ (lambda (p)
+ (format p "StorePath: ~a
+URL: ~a
+Compression: none
+NarSize: 1234
+References:
+System: ~a
+Deriver: ~a~%"
+ output ; StorePath
+ (string-append dir "/example.nar") ; URL
+ (%current-system) ; System
+ (basename drv-path)))) ; Deriver
+
+ (let-values (((build download)
+ (derivation-prerequisites-to-build store drv))
+ ((build* download*)
+ (derivation-prerequisites-to-build store drv
+ #:use-substitutes? #f)))
+ (pk build download build* download*)
+ (and (null? build)
+ (equal? download (list output))
+ (null? download*)
+ (null? build*)))))
+
(test-assert "build-expression->derivation with expression returning #f"
(let* ((builder '(begin
(mkdir %output)
(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)
(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))))
+(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?
- (file-exists? (derivation-path->output-path drv-path)))))
+ (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:
HCoop / jackhill / guix / guix.git / blobdiff