juli pushed a commit to branch wip-goblinsify
in repository shepherd.
commit 1146fe8ba57bb900c6180e71264f6d92fe5930a0
Author: Juliana Sims <j...@incana.org>
AuthorDate: Thu Jan 16 15:13:19 2025 -0500
Add test file for Goblins port.
This file will evolve, change, and grow over time.
* goblins-port-test.scm: New file.
---
goblins-port-test.scm | 81 +++++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 81 insertions(+)
diff --git a/goblins-port-test.scm b/goblins-port-test.scm
new file mode 100644
index 0000000..dfb38a0
--- /dev/null
+++ b/goblins-port-test.scm
@@ -0,0 +1,81 @@
+(use-modules (fibers)
+ (fibers conditions)
+ (fibers timers)
+ (goblins)
+ (goblins actor-lib joiners)
+ (goblins actor-lib let-on)
+ (ice-9 match)
+ (shepherd service)
+ (shepherd support)
+ (srfi srfi-26))
+
+(define test-service
+ (service
+ '(test)
+ #:start (lambda _
+ (call-with-output-file "test"
+ (cut display "foo" <>))
+ #t)
+ #:stop (lambda _
+ (delete-file "test"))
+ #:respawn? #f))
+
+(define test-2-service
+ (service
+ '(test-2)
+ #:requirement '(test)
+ #:start (lambda _
+ (call-with-output-file "test-2"
+ (cut display "bar" <>))
+ #t)
+ #:stop (lambda _
+ (delete-file "test-2"))
+ #:actions (actions (hi "Say hi."
+ (lambda _
+ (display "start\n\nend\n")
+ #t))
+ (fail "Fail." (const #f)))
+ #:respawn? #f))
+
+(define spawn-with-system-service
+ (service
+ '(spawn-with-system)
+ #:start (make-system-constructor (format #f "echo starting from ~a"
+ (getcwd)))
+ #:stop (make-system-destructor (format #f "echo stopping from ~a"
+ (getcwd)))))
+
+(define broken-service
+ (service
+ '(broken)
+ #:requirement '()
+ #:start (lambda _
+ (mkdir "/this/throws/a/system/error"))
+ #:stop (const #f)
+ #:respawn? #f))
+
+(run-fibers
+ (lambda ()
+ (define done? (make-condition))
+
+ (with-vat (spawn-vat #:name 'shepherd-vat)
+ (with-service-registry
+
+ (register-services
+ (list test-service
+ test-2-service
+ spawn-with-system-service
+ broken-service))
+
+ (on (<- ((@@ (shepherd service) current-registry)) 'service-list)
+ (lambda (serv-list)
+ (format #t "~a~%" serv-list)
+ (let ((serv-1 ((@@ (shepherd service) %service-control)
test-service))
+ (serv-2 ((@@ (shepherd service) %service-control)
test-2-service)))
+ (let-on ((serv-2-started (<- serv-2 'start '())))
+ (let-on ((serv-1-stopped (<- serv-1 'stop '())))
+ (signal-condition! done?))))))))
+
+ (wait done?))
+ #:parallelism 1
+ #:hz 0)
