aboutsummaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-02-21 23:03:19 +0100
committerLudovic Courtès <ludo@gnu.org>2014-02-21 23:49:52 +0100
commit36bbbbd150f75c2a6dab2473643c3723e606e41d (patch)
tree3824cacfcc1762e8ca9cc3c1ccda5e81d722ae79 /tests
parent3140f2df423d1235c3766e3478a429ac89d882ed (diff)
downloadguix-36bbbbd150f75c2a6dab2473643c3723e606e41d.tar
guix-36bbbbd150f75c2a6dab2473643c3723e606e41d.tar.gz
derivations: Add support for recursive fixed-output derivations.
* guix/derivations.scm (<derivation-output>): Add 'recursive?' field. Adjust 'make-derivation-output' callers. (%read-derivation) <fixed-output>: When HASH-ALGO starts with 'r:', set the 'recursive?' field and drop 'r:' from the hash algo name. (write-derivation)[write-output]: Write the algo as 'r:HASH-ALGO' when the RECURSIVE? field is set. (derivation-hash) <fixed-output>: Prepend "r:" when RECURSIVE? is set. (fixed-output-path): New procedure. (derivation): Add #:recursive? parameter. Use 'fixed-output-path' to compute the output file name of a fixed output derivation. (build-expression->derivation): Add #:recursive? parameter. Pass it to 'derivation'. * tests/derivations.scm ("fixed-output derivation, recursive", "build-expression->derivation produces recursive fixed-output", "build-expression->derivation uses recursive fixed-output"): New tests. * doc/guix.texi (Derivations): Document #:recursive? for 'derivation'. Add #:recursive? for 'build-expression->derivation'.
Diffstat (limited to 'tests')
-rw-r--r--tests/derivations.scm70
1 files changed, 68 insertions, 2 deletions
diff --git a/tests/derivations.scm b/tests/derivations.scm
index f7cedde505..f31b00b8a2 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -23,7 +23,8 @@
#:use-module (guix utils)
#:use-module (guix hash)
#:use-module (guix base32)
- #:use-module ((guix packages) #:select (package-derivation))
+ #:use-module ((guix packages) #:select (package-derivation base32))
+ #:use-module ((guix build utils) #:select (executable-file?))
#:use-module ((gnu packages) #:select (search-bootstrap-binary))
#:use-module (gnu packages bootstrap)
#:use-module ((gnu packages guile) #:select (guile-1.8))
@@ -190,6 +191,23 @@
(equal? (derivation->output-path drv1)
(derivation->output-path drv2)))))
+(test-assert "fixed-output derivation, recursive"
+ (let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
+ "echo -n hello > $out" '()))
+ (hash (sha256 (string->utf8 "hello")))
+ (drv (derivation %store "fixed-rec"
+ %bash `(,builder)
+ #:inputs `((,builder))
+ #:hash (base32 "0sg9f58l1jj88w6pdrfdpj5x9b1zrwszk84j81zvby36q9whhhqa")
+ #:hash-algo 'sha256
+ #:recursive? #t))
+ (succeeded? (build-derivations %store (list drv))))
+ (and succeeded?
+ (let ((p (derivation->output-path drv)))
+ (and (equal? (string->utf8 "hello")
+ (call-with-input-file p get-bytevector-all))
+ (bytevector? (query-path-hash %store p)))))))
+
(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
@@ -637,6 +655,54 @@ Deriver: ~a~%"
(derivation-file-name final1)))
(build-derivations %store (list final1 final2)))))
+(test-assert "build-expression->derivation produces recursive fixed-output"
+ (let* ((builder '(begin
+ (use-modules (srfi srfi-26))
+ (mkdir %output)
+ (chdir %output)
+ (call-with-output-file "exe"
+ (cut display "executable" <>))
+ (chmod "exe" #o777)
+ (symlink "exe" "symlink")
+ (mkdir "subdir")))
+ (drv (build-expression->derivation %store "fixed-rec" builder
+ #:hash-algo 'sha256
+ #:hash (base32
+ "10k1lw41wyrjf9mxydi0is5nkpynlsvgslinics4ppir13g7d74p")
+ #:recursive? #t)))
+ (and (build-derivations %store (list drv))
+ (let* ((dir (derivation->output-path drv))
+ (exe (string-append dir "/exe"))
+ (link (string-append dir "/symlink"))
+ (subdir (string-append dir "/subdir")))
+ (and (executable-file? exe)
+ (string=? "executable"
+ (call-with-input-file exe get-string-all))
+ (string=? "exe" (readlink link))
+ (file-is-directory? subdir))))))
+
+(test-assert "build-expression->derivation uses recursive fixed-output"
+ (let* ((builder '(call-with-output-file %output
+ (lambda (port)
+ (display "hello" port))))
+ (fixed (build-expression->derivation %store "small-fixed-rec"
+ builder
+ #:hash-algo 'sha256
+ #:hash (base32
+ "0sg9f58l1jj88w6pdrfdpj5x9b1zrwszk84j81zvby36q9whhhqa")
+ #:recursive? #t))
+ (in (derivation->output-path fixed))
+ (builder `(begin
+ (mkdir %output)
+ (chdir %output)
+ (symlink ,in "symlink")))
+ (drv (build-expression->derivation %store "fixed-rec-user"
+ builder
+ #:inputs `(("fixed" ,fixed)))))
+ (and (build-derivations %store (list drv))
+ (let ((out (derivation->output-path drv)))
+ (string=? (readlink (string-append out "/symlink")) in)))))
+
(test-assert "build-expression->derivation with #:references-graphs"
(let* ((input (add-text-to-store %store "foo" "hello"
(list %bash %mkdir)))