From 9f3ea03516b506d7c0440867b9db08898390a981 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Wed, 17 May 2023 15:28:54 +0200
Subject: [PATCH] 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.
---
 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 @@
             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)