diff options
author | Ludovic Courtès <ludo@gnu.org> | 2019-11-30 17:17:00 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2019-11-30 23:50:40 +0100 |
commit | 99c45877a984dd0148151b2e304afef6fb04f1a5 (patch) | |
tree | 39a1e9ff9cbcb619842b6dea70e7efb4126b28c4 | |
parent | d70478da2b878350450b976686f29712c06745f3 (diff) |
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.
-rw-r--r-- | doc/guix.texi | 11 | ||||
-rw-r--r-- | guix/gexp.scm | 7 | ||||
-rw-r--r-- | tests/gexp.scm | 8 |
3 files changed, 22 insertions, 4 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index d188f06a43..661aa41785 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 b640c079e4..a96592ac76 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 50d0948659..84c16422c2 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) |