summaryrefslogtreecommitdiff
path: root/guix/gexp.scm
diff options
context:
space:
mode:
authorMaxim Cournoyer <maxim.cournoyer@gmail.com>2020-10-19 12:51:57 -0400
committerMaxim Cournoyer <maxim.cournoyer@gmail.com>2020-10-19 13:11:40 -0400
commit5e2140511c1ad9ccd731438b74d61b62111da1e6 (patch)
treea4ff748ad26e121b88469b5d921001ef1382be8f /guix/gexp.scm
parent9e3a5ee417ea7fe9721be8804ff047e80c4f22ed (diff)
parent353bdae32f72b720c7ddd706576ccc40e2b43f95 (diff)
Merge branch 'staging'
Conflicts: gnu/packages/admin.scm gnu/packages/commencement.scm gnu/packages/gdb.scm gnu/packages/llvm.scm gnu/packages/package-management.scm gnu/packages/tls.scm
Diffstat (limited to 'guix/gexp.scm')
-rw-r--r--guix/gexp.scm33
1 files changed, 29 insertions, 4 deletions
diff --git a/guix/gexp.scm b/guix/gexp.scm
index a8d890ccd2..b8c831ccc3 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -26,6 +26,8 @@
#:use-module (guix derivations)
#:use-module (guix grafts)
#:use-module (guix utils)
+ #:use-module (guix diagnostics)
+ #:use-module (guix i18n)
#:use-module (rnrs bytevectors)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
@@ -46,6 +48,7 @@
gexp-input-output
gexp-input-native?
+ assume-valid-file-name
local-file
local-file?
local-file-file
@@ -401,9 +404,15 @@ Here TARGET is bound to the cross-compilation triplet or #f."
(define (true file stat) #t)
(define* (%local-file file promise #:optional (name (basename file))
- #:key recursive? (select? true))
+ #:key
+ (literal? #t) location
+ recursive? (select? true))
;; This intermediate procedure is part of our ABI, but the underlying
;; %%LOCAL-FILE is not.
+ (when (and (not literal?) (not (string-prefix? "/" file)))
+ (warning (and=> location source-properties->location)
+ (G_ "resolving '~a' relative to current directory~%")
+ file))
(%%local-file file promise name recursive? select?))
(define (absolute-file-name file directory)
@@ -416,6 +425,12 @@ vicinity of DIRECTORY."
(string-append directory "/" file))
(else file))))
+(define-syntax-rule (assume-valid-file-name file)
+ "This is a syntactic keyword to tell 'local-file' that it can assume that
+the given file name is valid, even if it's not a string literal, and thus not
+warn about it."
+ file)
+
(define-syntax local-file
(lambda (s)
"Return an object representing local file FILE to add to the store; this
@@ -434,18 +449,28 @@ where FILE is the entry's absolute file name and STAT is the result of
This is the declarative counterpart of the 'interned-file' monadic procedure.
It is implemented as a macro to capture the current source directory where it
appears."
- (syntax-case s ()
+ (syntax-case s (assume-valid-file-name)
((_ 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.
+ ((_ (assume-valid-file-name file) rest ...)
+ ;; FILE is not a literal, so resolve it relative to the current
+ ;; directory. Since the user declared FILE is valid, do not pass
+ ;; #:literal? #f so that we do not warn about it later on.
#'(%local-file file
(delay (absolute-file-name file (getcwd)))
rest ...))
+ ((_ file rest ...)
+ ;; Resolve FILE relative to the current directory.
+ (with-syntax ((location (datum->syntax s (syntax-source s))))
+ #`(%local-file file
+ (delay (absolute-file-name file (getcwd)))
+ rest ...
+ #:location 'location
+ #:literal? #f))) ;warn if FILE is relative
((_)
#'(syntax-error "missing file name"))
(id