guix-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[shepherd] 04/04: support: ‘assert’ logs source location information.


From: Ludovic Courtès
Subject: [shepherd] 04/04: support: ‘assert’ logs source location information.
Date: Sun, 17 Dec 2023 16:57:11 -0500 (EST)

civodul pushed a commit to branch master
in repository shepherd.

commit 5dbde1c0fbe3b19cc8e11d9733837b8ab7040e59
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sun Dec 17 22:43:16 2023 +0100

    support: ‘assert’ logs source location information.
    
    * modules/shepherd/support.scm (assert): Rewrite to include source
    location info in the message.
---
 modules/shepherd/support.scm | 23 +++++++++++++++++------
 1 file changed, 17 insertions(+), 6 deletions(-)

diff --git a/modules/shepherd/support.scm b/modules/shepherd/support.scm
index 2b5f698..75e25df 100644
--- a/modules/shepherd/support.scm
+++ b/modules/shepherd/support.scm
@@ -89,12 +89,23 @@
      (write args)
      (newline))))
 
-;; Assert that expression EXPR does not evaluate to `#f'.
-(define-syntax-rule (assert EXPR)
-  (and (not EXPR)
-       (begin
-        (local-output (l10n "Assertion ~a failed.") 'EXPR)
-        (throw 'assertion-failed))))
+(define-syntax assert
+  (lambda (s)
+    "Assert that expression @var{exp} does not evaluate to @code{#f}."
+    (syntax-case s ()
+      ((_ exp)
+       (let ((location (and=> (syntax-source #'exp)
+                              (lambda (properties)
+                                (let ((file (assq-ref properties 'filename))
+                                      (line (assq-ref properties 'line)))
+                                  (if (and file line)
+                                      (string-append file ":"
+                                                     (number->string line))
+                                      "<unknown-location>"))))))
+         #`(unless exp
+             (local-output (l10n "~a: Assertion ~s failed.")
+                           #,location 'exp)
+             (throw 'assertion-failed)))))))
 
 (define-syntax-rule (let-loop loop ((variable value) ...)
                               body ...)



reply via email to

[Prev in Thread] Current Thread [Next in Thread]