[shepherd] 01/03: service: ‘load’ action of root only re-throws service errors.

[Ludovic Courtès]

civodul pushed a commit to branch devel
in repository shepherd.

commit fda83421b519294d370f8ddfd4dc2d2e9e22e3bc
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Mon May 13 22:47:13 2024 +0200

    service: ‘load’ action of root only re-throws service errors.
    
    SRFI-35 exceptions other than ‘&service-error’ were, in fact, not
    handled by the caller, contrary to what the comment said.  This re-throw
    behavior was added in 9161450cb800f09ba617f456df9d2ec55ebf242b.
    
    * modules/shepherd/service.scm (perform-service-action): Do not re-throw
    when KEY is '%exception.
    * tests/eval-load.sh: Test it.
---
 modules/shepherd/service.scm |  5 +++--
 tests/eval-load.sh           | 12 +++++++++++-
 2 files changed, 14 insertions(+), 3 deletions(-)

diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index aba9c75..fe50855 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -1120,8 +1120,9 @@ the action."
              (eq? key 'quit)
              (apply quit args))
 
-        ;; Re-throw SRFI-34 exceptions that the caller will handle.
-        (cond ((eq? key '%exception)              ;Guile 3.x
+        ;; Re-throw service errors that the caller will handle.
+        (cond ((and (eq? key '%exception)         ;Guile 3.x
+                    (service-error? (car args)))
                (raise-exception (car args)))
               (else
                (report-exception the-action service key args)))))))
diff --git a/tests/eval-load.sh b/tests/eval-load.sh
index 0e282c5..3ad0f25 100755
--- a/tests/eval-load.sh
+++ b/tests/eval-load.sh
@@ -1,5 +1,5 @@
 # GNU Shepherd --- Check whether config can be loaded with 'primitive-load'
-# Copyright © 2023 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2023-2024 Ludovic Courtès <ludo@gnu.org>
 #
 # This file is part of the GNU Shepherd.
 #
@@ -59,3 +59,13 @@ $herd status | grep ' - a'
 $herd status | grep ' - b'
 $herd start a
 $herd start b
+
+# Ensure exceptions from the 'load' action are properly handled.
+cat > "$conf" <<EOF
+(use-modules (srfi srfi-34) (srfi srfi-35))
+
+(raise (condition (&message (message "Oops!"))))
+EOF
+
+$herd load root "$conf" && false
+$herd status