mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2025-01-12 14:16:55 -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 derivations)
|
||||||
#:use-module (guix grafts)
|
#:use-module (guix grafts)
|
||||||
#:use-module (guix utils)
|
#:use-module (guix utils)
|
||||||
|
#:use-module (guix diagnostics)
|
||||||
|
#:use-module (guix i18n)
|
||||||
#:use-module (rnrs bytevectors)
|
#:use-module (rnrs bytevectors)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (srfi srfi-9)
|
#:use-module (srfi srfi-9)
|
||||||
|
@ -401,9 +403,15 @@ (define-record-type <local-file>
|
||||||
(define (true file stat) #t)
|
(define (true file stat) #t)
|
||||||
|
|
||||||
(define* (%local-file file promise #:optional (name (basename file))
|
(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
|
;; This intermediate procedure is part of our ABI, but the underlying
|
||||||
;; %%LOCAL-FILE is not.
|
;; %%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?))
|
(%%local-file file promise name recursive? select?))
|
||||||
|
|
||||||
(define (absolute-file-name file directory)
|
(define (absolute-file-name file directory)
|
||||||
|
@ -443,9 +451,12 @@ (define-syntax local-file
|
||||||
rest ...))
|
rest ...))
|
||||||
((_ file rest ...)
|
((_ file rest ...)
|
||||||
;; Resolve FILE relative to the current directory.
|
;; Resolve FILE relative to the current directory.
|
||||||
#'(%local-file file
|
(with-syntax ((location (datum->syntax s (syntax-source s))))
|
||||||
|
#`(%local-file file
|
||||||
(delay (absolute-file-name file (getcwd)))
|
(delay (absolute-file-name file (getcwd)))
|
||||||
rest ...))
|
#:location 'location
|
||||||
|
#:literal? #f
|
||||||
|
rest ...)))
|
||||||
((_)
|
((_)
|
||||||
#'(syntax-error "missing file name"))
|
#'(syntax-error "missing file name"))
|
||||||
(id
|
(id
|
||||||
|
|
|
@ -76,6 +76,7 @@ guix/scripts/weather.scm
|
||||||
guix/scripts/describe.scm
|
guix/scripts/describe.scm
|
||||||
guix/scripts/processes.scm
|
guix/scripts/processes.scm
|
||||||
guix/scripts/deploy.scm
|
guix/scripts/deploy.scm
|
||||||
|
guix/gexp.scm
|
||||||
guix/gnu-maintenance.scm
|
guix/gnu-maintenance.scm
|
||||||
guix/scripts/container.scm
|
guix/scripts/container.scm
|
||||||
guix/scripts/container/exec.scm
|
guix/scripts/container/exec.scm
|
||||||
|
|
|
@ -297,6 +297,20 @@ EOF
|
||||||
guix system build "$tmpdir/config.scm" -n
|
guix system build "$tmpdir/config.scm" -n
|
||||||
(cd "$tmpdir"; guix system build "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.
|
# Searching.
|
||||||
guix system search tor | grep "^name: tor"
|
guix system search tor | grep "^name: tor"
|
||||||
guix system search tor | grep "^shepherdnames: tor"
|
guix system search tor | grep "^shepherdnames: tor"
|
||||||
|
|
Loading…
Reference in a new issue