From 99634e3ff4e16edc1c14145a5913d7c1440dc479 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Mon, 11 Jun 2012 23:12:55 +0200
Subject: Add `imported-files'.

* guix/derivations.scm (imported-files): New procedure.
  (build-expression->derivation): Correctly handle inputs that are
  sources and not derivation paths.

* tests/derivations.scm ("imported-files"): New test.
---
 tests/derivations.scm | 22 ++++++++++++++++++++--
 1 file changed, 20 insertions(+), 2 deletions(-)

(limited to 'tests/derivations.scm')

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))
-- 
cgit v1.2.3