[bug#63571] [PATCH 07/14] diagnostics: Factorize 'absolute-location'.

[Ludovic Courtès]

* guix/scripts/style.scm (absolute-location): Move to...
* guix/diagnostics.scm (absolute-location): ... here.
* guix/upstream.scm (update-package-source): Use it.
---
 guix/diagnostics.scm   | 20 +++++++++++++++++++-
 guix/scripts/style.scm | 17 -----------------
 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 @@ (define-module (guix diagnostics)
             location-file
             location-line
             location-column
+            absolute-location
             source-properties->location
             location->source-properties
             location->string
@@ -340,6 +341,23 @@ (define-syntax formatted-message
               (&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 00c7d3f90c..3f5d757e10 100644
--- a/guix/scripts/style.scm
+++ b/guix/scripts/style.scm
@@ -225,23 +225,6 @@ (define (edit-expression/dry-run properties rewrite-string)
                              (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 6f2a4dca28..29dd923e63 100644
--- a/guix/upstream.scm
+++ b/guix/upstream.scm
@@ -630,8 +630,8 @@ (define* (update-package-source package source hash)
               ;; 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)
-- 
2.40.1