From 99c45877a984dd0148151b2e304afef6fb04f1a5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sat, 30 Nov 2019 17:17:00 +0100 Subject: [PATCH] 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 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 @@ (define-syntax local-file 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 @@ (define %extension-package (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)