diff options
| -rw-r--r-- | guix/diagnostics.scm | 20 | ||||
| -rw-r--r-- | guix/scripts/style.scm | 17 | ||||
| -rw-r--r-- | guix/upstream.scm | 4 |
3 files changed, 21 insertions, 20 deletions
diff --git a/guix/diagnostics.scm b/guix/diagnostics.scm index 9f0d558f2f..3f1f527b43 100644 --- a/guix/diagnostics.scm +++ b/guix/diagnostics.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012-2021, 2023 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -36,6 +36,7 @@ location-file location-line location-column + absolute-location source-properties->location location->source-properties location->string @@ -340,6 +341,23 @@ number of arguments in ARGS matches the escapes in FORMAT." (&formatted-message (format str) (arguments (list args ...)))))))))) +(define (absolute-location loc) + "Replace the file name in LOC by an absolute location." + (location (if (string-prefix? "/" (location-file loc)) + (location-file loc) + + ;; 'search-path' might return #f in obscure cases, such as + ;; when %LOAD-PATH includes "." or ".." and LOC comes from a + ;; file in a subdirectory thereof. + (match (search-path %load-path (location-file loc)) + (#f + (raise (formatted-message + (G_ "file '~a' not found on load path") + (location-file loc)))) + (str str))) + (location-line loc) + (location-column loc))) + (define guix-warning-port (make-parameter (current-warning-port))) diff --git a/guix/scripts/style.scm b/guix/scripts/style.scm index 1d02742524..4920a8d969 100644 --- a/guix/scripts/style.scm +++ b/guix/scripts/style.scm @@ -226,23 +226,6 @@ doing it." (G_ "would be edited~%"))) str))) -(define (absolute-location loc) - "Replace the file name in LOC by an absolute location." - (location (if (string-prefix? "/" (location-file loc)) - (location-file loc) - - ;; 'search-path' might return #f in obscure cases, such as - ;; when %LOAD-PATH includes "." or ".." and LOC comes from a - ;; file in a subdirectory thereof. - (match (search-path %load-path (location-file loc)) - (#f - (raise (formatted-message - (G_ "file '~a' not found on load path") - (location-file loc)))) - (str str))) - (location-line loc) - (location-column loc))) - (define (trivial-package-arguments? package) "Return true if PACKAGE has zero arguments or only \"trivial\" arguments guaranteed not to refer to input labels." diff --git a/guix/upstream.scm b/guix/upstream.scm index 52f9333878..4ae2d1c8c8 100644 --- a/guix/upstream.scm +++ b/guix/upstream.scm @@ -637,8 +637,8 @@ new version string if an update was made, and #f otherwise." ;; function of the person who uploads the package. Note that ;; package definitions usually concatenate fragments of the URL, ;; which is why we only attempt to replace a subset of the URL. - (let ((properties (assq-set! (location->source-properties loc) - 'filename file)) + (let ((properties (location->source-properties + (absolute-location loc))) (replacements `((,old-version . ,version) (,old-hash . ,hash) ,@(if (and old-commit new-commit) |