-;;; Guix --- Nix package management from Guile. -*- coding: utf-8 -*-
-;;; Copyright (C) 2012, 2013 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 utils)
#:use-module (guix base32)
#:use-module ((guix packages) #:select (package-derivation))
- #:use-module (distro packages bootstrap)
+ #: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)
(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))
(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!"))
(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"
+ "(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)
+ %bash `(,builder)
`(("in"
;; Cheat to pass the actual file
;; name to the builder.
. ,(add-to-store %store
(basename input)
- #t #t "sha256"
+ #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))))))
+ ;; 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)
+ %bash `(,builder)
'()
`((,builder)) ; optional
#:hash hash #:hash-algo 'sha256))
"echo hey; echo -n hello > $out" '()))
(hash (sha256 (string->utf8 "hello")))
(drv-path1 (derivation %store "fixed" (%current-system)
- "/bin/sh" `(,builder1)
+ %bash `(,builder1)
'() `()
#:hash hash #:hash-algo 'sha256))
(drv-path2 (derivation %store "fixed" (%current-system)
- "/bin/sh" `(,builder2)
+ %bash `(,builder2)
'() `()
#:hash hash #:hash-algo 'sha256))
(succeeded? (build-derivations %store
"echo hey; echo -n hello > $out" '()))
(hash (sha256 (string->utf8 "hello")))
(fixed1 (derivation %store "fixed" (%current-system)
- "/bin/sh" `(,builder1)
+ %bash `(,builder1)
'() `()
#:hash hash #:hash-algo 'sha256))
(fixed2 (derivation %store "fixed" (%current-system)
- "/bin/sh" `(,builder2)
+ %bash `(,builder2)
'() `()
#:hash hash #:hash-algo 'sha256))
(fixed-out (derivation-path->output-path fixed1))
;; 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)
+ %bash `(,builder3)
`(("in" . ,fixed-out))
`((,builder3) (,fixed1))))
(final2 (derivation %store "final" (%current-system)
- "/bin/sh" `(,builder3)
+ %bash `(,builder3)
`(("in" . ,fixed-out))
`((,builder3) (,fixed2))))
(succeeded? (build-derivations %store
"echo one > $out ; echo two > $second"
'()))
(drv-path (derivation %store "fixed" (%current-system)
- "/bin/sh" `(,builder)
+ %bash `(,builder)
'(("HOME" . "/homeless")
("zzz" . "Z!")
("AAA" . "A!"))
"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
'()))
(drv-path
(derivation %store "foo" (%current-system)
- "/bin/sh" `(,builder)
+ %bash `(,builder)
`(("PATH" .
,(string-append
(derivation-path->output-path %coreutils)
;; 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)
\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