diff options
author | Richard Sent <richard@freakingpenguin.com> | 2024-05-08 14:45:07 -0400 |
---|---|---|
committer | Guix Patches Tester <> | 2024-05-08 21:28:17 +0200 |
commit | ad14eb6a67422c3eadc52c448bc483d7c6d00e62 (patch) | |
tree | 751f584ffaaca17e7fe22885f7566c19fcec1b06 | |
parent | 650890d4c05e9fe4a4b07a859468689ae8587543 (diff) | |
download | guix-patches-issue-70829.tar guix-patches-issue-70829.tar.gz |
guix: gexp: Add assume-source-relative-file-nameissue-70829
guix/gexp.scm (assume-source-relative-file-name): Create syntax rule
(local-file): Use assume-source-relative-file-name to look up a non-literal
file relative to the current source directory.
doc/guix.texi (G-expressions): Document it.
tests/gexp.scm: Test it.
Change-Id: Ibc24239ad201797c151b01e0b4fec43b07b4a02f
-rw-r--r-- | doc/guix.texi | 5 | ||||
-rw-r--r-- | guix/gexp.scm | 15 | ||||
-rw-r--r-- | tests/gexp.scm | 6 |
3 files changed, 25 insertions, 1 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index 221db5c022..1fc7be7cd8 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -12166,6 +12166,11 @@ Wrapping is done like this: (local-file (assume-valid-file-name alice-key-file-path)) @end lisp +@var{file} can be wrapped in the @code{assume-source-relative-file-name} +syntactic keyword. When this is done, the file name will be looked up +relative to the source file where it appears even when it is not a +string literal. + This is the declarative counterpart of the @code{interned-file} monadic procedure (@pxref{The Store Monad, @code{interned-file}}). @end deffn diff --git a/guix/gexp.scm b/guix/gexp.scm index 74b4c49f90..871e59cfdc 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -52,6 +52,7 @@ gexp-input-native? assume-valid-file-name + assume-source-relative-file-name local-file local-file? local-file-file @@ -485,6 +486,12 @@ the given file name is valid, even if it's not a string literal, and thus not warn about it." file) +(define-syntax-rule (assume-source-relative-file-name file) + "This is a syntactic keyword to tell 'local-file' that it can assume that +the given file is relative to the source directory, even if it's not a string +literal." + file) + (define-syntax local-file (lambda (s) "Return an object representing local file FILE to add to the store; this @@ -503,13 +510,19 @@ 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 (assume-valid-file-name) + (syntax-case s (assume-valid-file-name assume-source-relative-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 ...)) + ((_ (assume-source-relative-file-name file) rest ...) + ;; FILE is not a literal, but the user requested we look it up + ;; relative to the current source directory. + #'(%local-file file + (delay (absolute-file-name file (current-source-directory))) + rest ...)) ((_ (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 diff --git a/tests/gexp.scm b/tests/gexp.scm index 905009caee..8774097bd0 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -244,6 +244,12 @@ (let ((file (local-file (string-copy "../base32.scm")))) (local-file-absolute-file-name file))))) +(test-equal "local-file, non-literal source relative file name" + (current-filename) + (let ((file (local-file (assume-source-relative-file-name + (string-append "gexp" ".scm"))))) + (local-file-absolute-file-name file))) + (test-assert "local-file, relative file name, within gexp" (let* ((file (search-path %load-path "guix/base32.scm")) (interned (add-to-store %store "base32.scm" #f "sha256" file))) |