-;;; 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) #:select (search-bootstrap-binary))
- #: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)
(define %bash
(let ((bash (search-bootstrap-binary "bash" (%current-system))))
(and %store
- (add-to-store %store "bash" #t #t "sha256" bash))))
+ (add-to-store %store "bash" #t "sha256" bash))))
(define (directory-contents dir)
"Return an alist representing the contents of 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 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"
;; 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"
(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"
;; 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