mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 05:18:07 -05:00
gexp: 'local-file' warns when passed a non-literal relative file name.
Fixes <https://bugs.gnu.org/43736>. Reported by Vitaliy Shatrov <guix.vits@disroot.org>. * guix/gexp.scm (%local-file): Add #:literal? and #:location. Emit a warning when LITERAL? is false and FILE is not absolute. (local-file): In the non-literal case, pass #:location and #:literal?. * po/guix/POTFILES.in: Add guix/gexp.scm. * tests/guix-system.sh: Add test for the warning.
This commit is contained in:
parent
23dc21f05b
commit
f43ffee908
3 changed files with 30 additions and 4 deletions
|
@ -26,6 +26,8 @@ (define-module (guix gexp)
|
|||
#: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)
|
||||
|
@ -401,9 +403,15 @@ (define-record-type <local-file>
|
|||
(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)
|
||||
|
@ -443,9 +451,12 @@ (define-syntax local-file
|
|||
rest ...))
|
||||
((_ file rest ...)
|
||||
;; Resolve FILE relative to the current directory.
|
||||
#'(%local-file file
|
||||
(delay (absolute-file-name file (getcwd)))
|
||||
rest ...))
|
||||
(with-syntax ((location (datum->syntax s (syntax-source s))))
|
||||
#`(%local-file file
|
||||
(delay (absolute-file-name file (getcwd)))
|
||||
#:location 'location
|
||||
#:literal? #f
|
||||
rest ...)))
|
||||
((_)
|
||||
#'(syntax-error "missing file name"))
|
||||
(id
|
||||
|
|
|
@ -76,6 +76,7 @@ guix/scripts/weather.scm
|
|||
guix/scripts/describe.scm
|
||||
guix/scripts/processes.scm
|
||||
guix/scripts/deploy.scm
|
||||
guix/gexp.scm
|
||||
guix/gnu-maintenance.scm
|
||||
guix/scripts/container.scm
|
||||
guix/scripts/container/exec.scm
|
||||
|
|
|
@ -297,6 +297,20 @@ EOF
|
|||
guix system build "$tmpdir/config.scm" -n
|
||||
(cd "$tmpdir"; guix system build "config.scm" -n)
|
||||
|
||||
# Check that we get a warning when passing 'local-file' a non-literal relative
|
||||
# file name.
|
||||
cat > "$tmpdir/config.scm" <<EOF
|
||||
(use-modules (guix))
|
||||
|
||||
(define (bad-local-file file)
|
||||
(local-file file))
|
||||
|
||||
(bad-local-file "whatever.scm")
|
||||
EOF
|
||||
! guix system build "$tmpdir/config.scm" -n
|
||||
guix system build "$tmpdir/config.scm" -n 2>&1 | \
|
||||
grep "config\.scm:4:2: warning:.*whatever.*relative to current directory"
|
||||
|
||||
# Searching.
|
||||
guix system search tor | grep "^name: tor"
|
||||
guix system search tor | grep "^shepherdnames: tor"
|
||||
|
|
Loading…
Reference in a new issue