[shepherd] 03/05: support: Make the 'load' and 'eval' actions suspendable.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository shepherd.

commit f1f5929dd210281e417e6b0645879c820613c255
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Wed Nov 16 16:59:38 2022 +0100

    support: Make the 'load' and 'eval' actions suspendable.
    
    * modules/shepherd/support.scm (primitive-load*): New procedure.
    (load-in-user-module): Use it instead of 'load-in-user-module'.
    (eval-in-user-module): Use 'primitive-eval' instead of 'eval'.
    * tests/basic.sh: Test (@ (fibers) sleep) within 'herd eval root'.
---
 modules/shepherd/support.scm | 19 +++++++++++++++++--
 tests/basic.sh               |  3 +++
 2 files changed, 20 insertions(+), 2 deletions(-)

diff --git a/modules/shepherd/support.scm b/modules/shepherd/support.scm
index a68bbd4..ed02d89 100644
--- a/modules/shepherd/support.scm
+++ b/modules/shepherd/support.scm
@@ -361,20 +361,35 @@ which has essential bindings pulled in."
     (module-use! m (resolve-interface '(shepherd service)))
     m))
 
+(define (primitive-load* file)
+  ;; Like 'primitive-load', but in Scheme, so that it does not introduce a
+  ;; continuation barrier that would prevent code in FILE from suspending.
+  (call-with-input-file file
+    (lambda (port)
+      (let loop ((result *unspecified*))
+       (match (read port)
+         ((? eof-object?)
+          result)
+         (exp
+          (loop (primitive-eval exp))))))))
+
 (define (load-in-user-module file)
   "Load FILE in a fresh user module that has essential bindings pulled in."
   (let ((user-module (make-user-module)))
     (save-module-excursion
      (lambda ()
        (set-current-module user-module)
-       (primitive-load file)))))
+       (primitive-load* file)))))
 
 (define (eval-in-user-module exp)
   "Eval EXP in a fresh user module that has essential bindings pulled in."
   (let ((user-module (make-user-module)))
     (save-module-excursion
      (lambda ()
-       (eval exp user-module)))))
+       ;; Note: As of Guile 3.0.8, 'eval' is written in C, and is thus a
+       ;; continuation barrier.  Use 'primitive-eval' to avoid that.
+       (set-current-module user-module)
+       (primitive-eval exp)))))
 
 (define* (verify-dir dir #:key (secure? #t))
   "Check if the directory DIR exists and create it if it is the default
diff --git a/tests/basic.sh b/tests/basic.sh
index 9baeb65..07e9767 100644
--- a/tests/basic.sh
+++ b/tests/basic.sh
@@ -244,6 +244,9 @@ then false; else true; fi
 
 $herd eval root '(values)'
 
+# Make sure we can suspend from an action.
+$herd eval root '((@ (fibers) sleep) 1)'
+
 # Unload everything and make sure only 'root' is left.
 $herd unload root all
 if $herd status | grep "Stopped:"