[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[shepherd] 03/05: support: Make the 'load' and 'eval' actions suspendabl
From: |
Ludovic Courtès |
Subject: |
[shepherd] 03/05: support: Make the 'load' and 'eval' actions suspendable. |
Date: |
Wed, 16 Nov 2022 18:00:58 -0500 (EST) |
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:"
- [shepherd] branch master updated (ada8807 -> 4c031cf), Ludovic Courtès, 2022/11/16
- [shepherd] 03/05: support: Make the 'load' and 'eval' actions suspendable.,
Ludovic Courtès <=
- [shepherd] 05/05: Update 'NEWS'., Ludovic Courtès, 2022/11/16
- [shepherd] 02/05: service: 'eval' action gracefully handles user code returning zero values., Ludovic Courtès, 2022/11/16
- [shepherd] 04/05: shepherd: Restore 'system*' in the child process after fork., Ludovic Courtès, 2022/11/16
- [shepherd] 01/05: service: 'make-kill-destructor' waits for termination, eventually SIGKILLs., Ludovic Courtès, 2022/11/16