provide shutdown for root service, calling shutdown for all child services

This commit is contained in:
Helmut Merz 2024-06-25 17:35:35 +02:00
parent 0f23d62ad6
commit c3f4c20a75
3 changed files with 19 additions and 9 deletions

View file

@ -6,7 +6,8 @@
(:use :common-lisp)
(:export #:base #:root #:*root*
#:env-data #:env-keys #:env-prefix #:env-path
#:actions #:add #:add-action #:children #:env-slots #:name #:setup #:parent))
#:actions #:add #:add-action #:children #:env-slots
#:name #:setup #:parent #:shutdown))
(in-package :scopes/config)
@ -60,6 +61,7 @@
(name :reader name :initarg :name)
(parent :reader parent :initarg :parent)
(setup :reader setup :initarg :setup :initform #'(lambda (cfg)))
(shutdown :reader shutdown :initarg :shutdown :initform #'(lambda (ctx)))
(actions :accessor actions :initarg :actions :initform nil)))
(defmethod initialize-instance :after ((cfg base) &key parent &allow-other-keys)

View file

@ -3,9 +3,10 @@
(defpackage :scopes/core
(:use :common-lisp)
(:local-nicknames (:config :scopes/config)
(:message :scopes/core/message))
(:message :scopes/core/message)
(:alx :alexandria))
(:export #:*root* #:default-setup #:find-service #:setup-services
#:context #:add-action #:config #:name #:send
#:context #:add-action #:config #:name #:send #:shutdown
#:printer))
(in-package :scopes/core)
@ -45,7 +46,7 @@
((config :reader config :initarg :config)
(name :reader name :initarg :name)
(actions :accessor actions :initform nil)
(services :initform (make-hash-table))))
(services :reader services :initform (make-hash-table))))
(defun default-setup (cfg &optional (cls 'context))
(make-instance cls :config cfg :name (config:name cfg)))
@ -60,6 +61,10 @@
(dolist (c (config:children cfg))
(add-service *root* c)))
(defun shutdown ()
(dolist (ctx (alx:hash-table-values (services *root*)))
(funcall (config:shutdown (config ctx)) ctx)))
(defun add-action (ctx pat hdlr)
(let* ((acts (actions ctx))
(act (find-action pat acts)))

View file

@ -53,11 +53,14 @@
(t:*test-suite* (make-instance 'test-suite :name "core")))
(log4cl:log-config :sane :daily (t:test-path "scopes-test.log" "log"))
(load (t:test-path "config-core" "etc"))
(unwind-protect
(progn
(core:setup-services *config*)
(setf (receiver t:*test-suite*) (core:find-service :test-receiver))
(test-send)
(test-send))
(core:shutdown)
(check-expected)
(t:show-result)))
(t:show-result))))
(deftest test-send ()
(let ((rcvr (receiver t:*test-suite*))