[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
02/04: gexp: 'local-file' properly resolves non-literal relative file na
From: |
guix-commits |
Subject: |
02/04: gexp: 'local-file' properly resolves non-literal relative file names. |
Date: |
Sat, 30 Nov 2019 17:50:50 -0500 (EST) |
civodul pushed a commit to branch master
in repository guix.
commit 99c45877a984dd0148151b2e304afef6fb04f1a5
Author: Ludovic Courtès <address@hidden>
Date: Sat Nov 30 17:17:00 2019 +0100
gexp: 'local-file' properly resolves non-literal relative file names.
* guix/gexp.scm (local-file): Distinguish the case where FILE is a
literal string and when it's not. Add a clause for when FILE is not a
literal string.
* tests/gexp.scm ("local-file, non-literal relative file name"): New test.
* doc/guix.texi (G-Expressions): Update accordingly.
---
doc/guix.texi | 11 +++++++----
guix/gexp.scm | 7 +++++++
tests/gexp.scm | 8 ++++++++
3 files changed, 22 insertions(+), 4 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index d188f06..661aa41 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -7684,10 +7684,13 @@ content is directly passed as a string.
@deffn {Scheme Procedure} local-file @var{file} [@var{name}] @
[#:recursive? #f] [#:select? (const #t)]
-Return an object representing local file @var{file} to add to the store; this
-object can be used in a gexp. If @var{file} is a relative file name, it is
looked
-up relative to the source file where this form appears. @var{file} will be
added to
-the store under @var{name}--by default the base name of @var{file}.
+Return an object representing local file @var{file} to add to the store;
+this object can be used in a gexp. If @var{file} is a literal string
+denoting a relative file name, it is looked up relative to the source
+file where it appears; if @var{file} is not a literal string, it is
+looked up relative to the current working directory at run time.
+@var{file} will be added to the store under @var{name}--by default the
+base name of @var{file}.
When @var{recursive?} is true, the contents of @var{file} are added
recursively; if @var{file}
designates a flat file and @var{recursive?} is true, its contents are added,
and its
diff --git a/guix/gexp.scm b/guix/gexp.scm
index b640c07..a96592a 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -320,9 +320,16 @@ It is implemented as a macro to capture the current source
directory where it
appears."
(syntax-case s ()
((_ file rest ...)
+ (string? (syntax->datum #'file))
+ ;; FILE is a literal, so resolve it relative to the source directory.
#'(%local-file file
(delay (absolute-file-name file
(current-source-directory)))
rest ...))
+ ((_ file rest ...)
+ ;; Resolve FILE relative to the current directory.
+ #'(%local-file file
+ (delay (absolute-file-name file (getcwd)))
+ rest ...))
((_)
#'(syntax-error "missing file name"))
(id
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 50d0948..84c1642 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -170,6 +170,14 @@
(let ((file (local-file "../guix/base32.scm")))
(local-file-absolute-file-name file)))))
+(test-equal "local-file, non-literal relative file name"
+ (canonicalize-path (search-path %load-path "guix/base32.scm"))
+ (let ((directory (dirname (search-path %load-path
+ "guix/build-system/gnu.scm"))))
+ (with-directory-excursion directory
+ (let ((file (local-file (string-copy "../base32.scm"))))
+ (local-file-absolute-file-name file)))))
+
(test-assertm "local-file, #:select?"
(mlet* %store-monad ((select? -> (lambda (file stat)
(member (basename file)