stellarskylark
/
guix
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

diagnostics: Factorize 'absolute-location'. 

* guix/scripts/style.scm (absolute-location): Move to...
* guix/diagnostics.scm (absolute-location): ... here.
* guix/upstream.scm (update-package-source): Use it.
This commit is contained in:
Ludovic Courtès 2023-05-17 15:28:54 +02:00
parent e6223017d9
commit 9f3ea03516
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 21 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
guix/diagnostics.scm
View File

@ -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)))

17
guix/scripts/style.scm
View File

@ -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."

4
guix/upstream.scm
View File

@ -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)