diff options
| -rw-r--r-- | guix/derivations.scm | 52 | ||||
| -rw-r--r-- | tests/derivations.scm | 22 |
2 files changed, 70 insertions, 4 deletions
diff --git a/guix/derivations.scm b/guix/derivations.scm index b5e3db2d21..c35595fd1e 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -52,7 +52,8 @@ derivation %guile-for-build - build-expression->derivation)) + build-expression->derivation + imported-files)) ;;; ;;; Nix derivations, as implemented in Nix's `derivations.cc'. @@ -372,6 +373,51 @@ known in advance, such as a file download." ;; when using `build-expression->derivation'. (make-parameter (false-if-exception (nixpkgs-derivation "guile")))) +(define* (imported-files store files + #:key (name "file-import") (system (%current-system))) + "Return a derivation that imports FILES into STORE. FILES must be a list +of (FINAL-PATH . FILE-NAME) pairs; each FILE-NAME is read from the file +system, imported, and appears under FINAL-PATH in the resulting store path." + (define (parent-dirs file-name) + ;; Return the list of parent dirs of FILE-NAME, in the order in which an + ;; `mkdir -p' implementation would make them. + (let ((not-slash (char-set-complement (char-set #\/)))) + (reverse + (fold (lambda (dir result) + (match result + (() + (list dir)) + ((prev _ ...) + (cons (string-append prev "/" dir) + result)))) + '() + (remove (cut string=? <> ".") + (string-tokenize (dirname file-name) not-slash)))))) + + (let* ((files (map (match-lambda + ((final-path . file-name) + (cons final-path + (add-to-store store (basename final-path) #t #f + "sha256" file-name)))) + files)) + (builder + `(begin + (mkdir %output) (chdir %output) + ,@(append-map (match-lambda + ((final-path . store-path) + (append (match (parent-dirs final-path) + (() '()) + ((head ... tail) + (append (map (lambda (d) + `(false-if-exception + (mkdir ,d))) + head) + `((mkdir ,tail))))) + `((symlink ,store-path ,final-path))))) + files)))) + (build-expression->derivation store name (%current-system) + builder files))) + (define* (build-expression->derivation store name system exp inputs #:key (outputs '("out")) hash hash-algo) @@ -395,7 +441,9 @@ INPUTS." ',(map (match-lambda ((name . drv) (cons name - (derivation-path->output-path drv)))) + (if (derivation-path? drv) + (derivation-path->output-path drv) + drv)))) inputs))) ) (builder (add-text-to-store store (string-append name "-guile-builder") diff --git a/tests/derivations.scm b/tests/derivations.scm index ec48f44420..1a85639930 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -24,11 +24,13 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) #:use-module (srfi srfi-64) #:use-module (rnrs io ports) #:use-module (rnrs bytevectors) #:use-module (ice-9 rdelim) - #:use-module (ice-9 ftw)) + #:use-module (ice-9 ftw) + #:use-module (ice-9 match)) (define %store (false-if-exception (open-connection))) @@ -156,7 +158,7 @@ (let ((p (derivation-path->output-path drv-path))) (file-exists? (string-append p "/good")))))) -(test-skip (if (%guile-for-build) 0 2)) +(test-skip (if (%guile-for-build) 0 4)) (test-assert "build-expression->derivation without inputs" (let* ((builder '(begin @@ -208,6 +210,22 @@ (let ((p (derivation-path->output-path drv-path))) (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")))) + (drv-path (imported-files %store files))) + (and (build-derivations %store (list drv-path)) + (let ((dir (derivation-path->output-path drv-path))) + (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-skip (if (false-if-exception (getaddrinfo "ftp.gnu.org" "http")) 0 1)) |