ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-25 22:08:16 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

gexp: 'local-file' properly resolves non-literal relative file names.

Browse source 
* 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.
This commit is contained in:
Ludovic Courtès 2019-11-30 17:17:00 +01:00
parent d70478da2b
commit 99c45877a9
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
3 changed files with 22 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
doc/guix.texi
View file

@ -7684,10 +7684,13 @@ content is directly passed as a string.
@deffn {Scheme Procedure} local-file @var{file} [@var{name}] @ @deffn {Scheme Procedure} local-file @var{file} [@var{name}] @
[#:recursive? #f] [#:select? (const #t)] [#:recursive? #f] [#:select? (const #t)]
Return an object representing local file @var{file} to add to the store; this Return an object representing local file @var{file} to add to the store;
object can be used in a gexp. If @var{file} is a relative file name, it is looked this object can be used in a gexp. If @var{file} is a literal string
up relative to the source file where this form appears. @var{file} will be added to denoting a relative file name, it is looked up relative to the source
the store under @var{name}--by default the base name of @var{file}. 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} 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 designates a flat file and @var{recursive?} is true, its contents are added, and its

7
guix/gexp.scm
View file

@ -320,9 +320,16 @@ (define-syntax local-file
appears." appears."
(syntax-case s () (syntax-case s ()
((_ file rest ...) ((_ file rest ...)
(string? (syntax->datum #'file))
;; FILE is a literal, so resolve it relative to the source directory.
#'(%local-file file #'(%local-file file
(delay (absolute-file-name file (current-source-directory))) (delay (absolute-file-name file (current-source-directory)))
rest ...)) 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")) #'(syntax-error "missing file name"))
(id (id

8
tests/gexp.scm
View file

@ -170,6 +170,14 @@ (define %extension-package
(let ((file (local-file "../guix/base32.scm"))) (let ((file (local-file "../guix/base32.scm")))
(local-file-absolute-file-name file))))) (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?" (test-assertm "local-file, #:select?"
(mlet* %store-monad ((select? -> (lambda (file stat) (mlet* %store-monad ((select? -> (lambda (file stat)
(member (basename file) (member (basename file)