gexp: 'imported-files/derivation' can copy files instead of symlinking.

* guix/gexp.scm (imported-files/derivation): Add #:symlink? and honor
it.
(imported-files): Pass #:symlink? to 'imported-files/derivation'.
* tests/gexp.scm ("imported-files with file-like objects"): Add 'file=?'
and use it instead of calling 'readlink'.

2 files changed, 13 insertions, 6 deletions

diff --git a/guix/gexp.scm b/guix/gexp.scm
index 19d90f5eee..ffc976d61b 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -1078,6 +1078,7 @@ to a tree suitable for 'interned-file-tree'."
 
 (define* (imported-files/derivation files
                                     #:key (name "file-import")
+                                    (symlink? #f)
                                     (system (%current-system))
                                     (guile (%guile-for-build))
 
@@ -1091,7 +1092,8 @@ to a tree suitable for 'interned-file-tree'."
   "Return a derivation that imports FILES into STORE.  FILES must be a list
 of (FINAL-PATH . FILE) pairs.  Each FILE is mapped to FINAL-PATH in the
 resulting store path.  FILE can be either a file name, or a file-like object,
-as returned by 'local-file' for example."
+as returned by 'local-file' for example.  If SYMLINK? is true, create symlinks
+to the source files instead of copying them."
   (define file-pair
     (match-lambda
      ((final-path . (? string? file-name))
@@ -1114,7 +1116,8 @@ as returned by 'local-file' for example."
          (for-each (match-lambda
                     ((final-path store-path)
                      (mkdir-p (dirname final-path))
-                     (symlink store-path final-path)))
+                     ((ungexp (if symlink? 'symlink 'copy-file))
+                      store-path final-path)))
                    '(ungexp files)))))
 
     ;; TODO: Pass FILES as an environment variable so that BUILD remains
@@ -1160,6 +1163,7 @@ as returned by 'local-file' for example."
                  (_ #f))
                files))
       (imported-files/derivation files #:name name
+                                 #:symlink? derivation?
                                  #:system system #:guile guile
                                  #:deprecation-warnings deprecation-warnings)
       (interned-file-tree `(,name directory
diff --git a/tests/gexp.scm b/tests/gexp.scm
index c89d0c4855..b22e635805 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -652,16 +652,19 @@
                        (files -> `(("a/b/c" . ,q-scm)
                                    ("p/q"   . ,plain)))
                        (drv      (imported-files files)))
+    (define (file=? file1 file2)
+      ;; Assume deduplication is in place.
+      (= (stat:ino (lstat file1))
+         (stat:ino (lstat file2))))
+
     (mbegin %store-monad
       (built-derivations (list drv))
       (mlet %store-monad ((dir -> (derivation->output-path drv))
                           (plain* (text-file "foo" "bar!"))
                           (q-scm* (interned-file q-scm "c")))
         (return
-         (and (string=? (readlink (string-append dir "/a/b/c"))
-                        q-scm*)
-              (string=? (readlink (string-append dir "/p/q"))
-                        plain*)))))))
+         (and (file=? (string-append dir "/a/b/c") q-scm*)
+              (file=? (string-append dir "/p/q") plain*)))))))
 
 (test-equal "gexp-modules & ungexp"
   '((bar) (foo))