;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;; the contents.
(valid-path? %store (derivation->output-path drv)))))
+(test-assert "identical files are deduplicated"
+ (let* ((build1 (add-text-to-store %store "one.sh"
+ "echo hello, world > \"$out\"\n"
+ '()))
+ (build2 (add-text-to-store %store "two.sh"
+ "# Hey!\necho hello, world > \"$out\"\n"
+ '()))
+ (drv1 (derivation %store "foo"
+ %bash `(,build1)
+ #:inputs `((,%bash) (,build1))))
+ (drv2 (derivation %store "bar"
+ %bash `(,build2)
+ #:inputs `((,%bash) (,build2)))))
+ (and (build-derivations %store (list drv1 drv2))
+ (let ((file1 (derivation->output-path drv1))
+ (file2 (derivation->output-path drv2)))
+ (and (valid-path? %store file1) (valid-path? %store file2)
+ (string=? (call-with-input-file file1 get-string-all)
+ "hello, world\n")
+ (= (stat:ino (lstat file1))
+ (stat:ino (lstat file2))))))))
+
+(test-equal "derivation-name"
+ "foo-0.0"
+ (let ((drv (derivation %store "foo-0.0" %bash '())))
+ (derivation-name drv)))
+
+(test-equal "derivation-output-names"
+ '(("out") ("bar" "chbouib"))
+ (let ((drv1 (derivation %store "foo-0.0" %bash '()))
+ (drv2 (derivation %store "foo-0.0" %bash '()
+ #:outputs '("bar" "chbouib"))))
+ (list (derivation-output-names drv1)
+ (derivation-output-names drv2))))
+
+(test-assert "offloadable-derivation?"
+ (and (offloadable-derivation? (derivation %store "foo" %bash '()))
+ (not (offloadable-derivation?
+ (derivation %store "foo" %bash '()
+ #:local-build? #t)))))
+
(test-assert "fixed-output-derivation?"
(let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
"echo -n hello > $out" '()))
\f
(define %coreutils
(false-if-exception
- (and (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)
+ (and (network-reachable?)
(or (package-derivation %store %bootstrap-coreutils&co)
(nixpkgs-derivation "coreutils")))))
;; 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* ((store (open-connection))
(drv (build-expression->derivation store "prereq-subst"
(random 1000)))
- (output (derivation->output-path drv))
- (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
- (derivation-file-name drv))))) ; Deriver
+ (output (derivation->output-path drv)))
+
+ ;; Make sure substitutes are usable.
+ (set-build-options store #:use-substitutes? #t)
+
+ (with-derivation-narinfo drv
+ (let-values (((build download)
+ (derivation-prerequisites-to-build store drv))
+ ((build* download*)
+ (derivation-prerequisites-to-build store drv
+ #:substitutable?
+ (const #f))))
+ (and (null? build)
+ (equal? download (list output))
+ (null? download*)
+ (null? build*))))))
+
+(test-assert "derivation-prerequisites-to-build and substitutes, local build"
+ (let* ((store (open-connection))
+ (drv (build-expression->derivation store "prereq-subst-local"
+ (random 1000)
+ ;; XXX: Adjust once
+ ;; <http://bugs.gnu.org/18747>
+ ;; is fixed.
+ #:local-build? #t))
+ (output (derivation->output-path drv)))
;; Make sure substitutes are usable.
(set-build-options store #:use-substitutes? #t)
- (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*)))))
+ (with-derivation-narinfo drv
+ (let-values (((build download)
+ (derivation-prerequisites-to-build store drv)))
+ ;; Despite being available as a substitute, DRV will be built locally
+ ;; due to #:local-build?.
+ (and (null? download)
+ (match build
+ (((? derivation-input? input))
+ (string=? (derivation-input-path input)
+ (derivation-file-name drv)))))))))
(test-assert "build-expression->derivation with expression returning #f"
(let* ((builder '(begin
(let ((p (derivation->output-path drv)))
(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 (imported-files %store files)))
- (and (build-derivations %store (list drv))
- (let ((dir (derivation->output-path drv)))
- (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))
(string<? p1 p2)))))))))))))
+(test-assert "graft-derivation"
+ (let* ((build `(begin
+ (mkdir %output)
+ (chdir %output)
+ (symlink %output "self")
+ (call-with-output-file "text"
+ (lambda (output)
+ (format output "foo/~a/bar" ,%mkdir)))
+ (symlink ,%bash "sh")))
+ (orig (build-expression->derivation %store "graft" build
+ #:inputs `(("a" ,%bash)
+ ("b" ,%mkdir))))
+ (one (add-text-to-store %store "bash" "fake bash"))
+ (two (build-expression->derivation %store "mkdir"
+ '(call-with-output-file %output
+ (lambda (port)
+ (display "fake mkdir" port)))))
+ (graft (graft-derivation %store "graft" orig
+ (list (graft
+ (origin %bash)
+ (replacement one))
+ (graft
+ (origin %mkdir)
+ (replacement two))))))
+ (and (build-derivations %store (list graft))
+ (let ((two (derivation->output-path two))
+ (graft (derivation->output-path graft)))
+ (and (string=? (format #f "foo/~a/bar" two)
+ (call-with-input-file (string-append graft "/text")
+ get-string-all))
+ (string=? (readlink (string-append graft "/sh")) one)
+ (string=? (readlink (string-append graft "/self")) graft))))))
+
(test-equal "map-derivation"
"hello"
(let* ((joke (package-derivation %store guile-1.8))
HCoop / jackhill / guix / guix.git / blobdiff