tribes/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2026-04-06 21:20:33 +02:00
Code Activity

gexp: improve &gexp-input-error with &error-location.

Browse Source 
* guix/gexp.scm (gexp->sexp): raise &error-location along &gexp-input-error.
* guix/ui.scm (call-with-error-handling): use this.
* tests/gexp.scm (lower-gexp, invalid input location): New test.

Change-Id: Iee761e5f99502065182d9e6fc8d21399e99ec6c3
Signed-off-by: Ludovic Courtès <ludo@gnu.org>
Merges: #7538
This commit is contained in:
Yarl Baudig
2026-03-28 12:19:54 +01:00
committed by Ludovic Courtès
parent 1b08655ef8
commit 785f4c6ed9
3 changed files with 20 additions and 3 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
guix/gexp.scm
View File

@@ -1455,7 +1455,8 @@ and in the current monad setting (system type, etc.)"
(($ <gexp-input> (? self-quoting? x)) (($ <gexp-input> (? self-quoting? x))
(return x)) (return x))
(($ <gexp-input> x) (($ <gexp-input> x)
(raise (condition (&gexp-input-error (input x))))) (raise (condition (&gexp-input-error (input x))
(&error-location (location (gexp-location exp))))))
(x (x
(return x))))) (return x)))))

3
guix/ui.scm
View File

@@ -808,7 +808,8 @@ evaluating the tests and bodies of CLAUSES."
target))) target)))
((gexp-input-error? c) ((gexp-input-error? c)
(let ((input (gexp-error-invalid-input c))) (let ((input (gexp-error-invalid-input c)))
(leave (G_ "~s: invalid G-expression input~%") (leave (and (error-location? c) (error-location c))
(G_ "~s: invalid G-expression input~%")
(gexp-error-invalid-input c)))) (gexp-error-invalid-input c))))
((profile-not-found-error? c) ((profile-not-found-error? c)
(leave (G_ "profile '~a' does not exist~%") (leave (G_ "profile '~a' does not exist~%")

17
tests/gexp.scm
View File

@@ -33,7 +33,10 @@
#:use-module (gnu packages) #:use-module (gnu packages)
#:use-module (gnu packages base) #:use-module (gnu packages base)
#:use-module (gnu packages bootstrap) #:use-module (gnu packages bootstrap)
#:use-module ((guix diagnostics) #:select (guix-warning-port)) #:use-module ((guix diagnostics) #:select (error-location
error-location?
guix-warning-port
source-properties->location))
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-34) #:use-module (srfi srfi-34)
#:use-module (srfi srfi-64) #:use-module (srfi srfi-64)
@@ -1307,6 +1310,18 @@ importing.* \\(guix config\\) from the host"
(run-with-store %store (run-with-store %store
(lower-gexp #~(#\+))))) (lower-gexp #~(#\+)))))
(let* ((g #~#$*unspecified*)
(loc (current-source-location)) ;keep this alignment!
(g-loc (source-properties->location
`((line . ,(- (assq-ref loc 'line) 1))
,@(alist-delete 'line loc)))))
(test-equal "lower-gexp, invalid input location"
g-loc
(guard (c ((and (gexp-input-error? c) (error-location? c))
(error-location c)))
(run-with-store %store
(lower-gexp g)))))
(test-assertm "gexp->derivation #:references-graphs" (test-assertm "gexp->derivation #:references-graphs"
(mlet* %store-monad (mlet* %store-monad
((one (text-file "one" (random-text))) ((one (text-file "one" (random-text)))