From 10d4c9c687ef7114e0a75835677e4d52d96e7684 Mon Sep 17 00:00:00 2001
From: Helmut Merz <helmutm@cy55.de>
Date: Wed, 12 Jun 2024 13:22:41 +0200
Subject: [PATCH] work in progress: test receiver

---
 core/core.lisp      |  8 +++++---
 core/message.lisp   |  4 ++--
 test/test-core.lisp | 21 +++++++++++++++++++--
 testing.lisp        |  2 +-
 4 files changed, 27 insertions(+), 8 deletions(-)

diff --git a/core/core.lisp b/core/core.lisp
index ef198a1..0cf988d 100644
--- a/core/core.lisp
+++ b/core/core.lisp
@@ -4,7 +4,8 @@
   (:use :common-lisp)
   (:local-nicknames (:config :scopes/config))
   (:export #:config #:service-config
-           #:context #:name #:send
+           #:context #:name #:actions #:send
+           #:action-spec
            #:printer))
 
 (in-package :scopes/core)
@@ -34,13 +35,14 @@
     (let* ((acts (actions rcvr))
            (selected (car acts)))
       (dolist (hdlr (handlers selected))
-        (funcall hdlr msg)))))
+        (funcall hdlr rcvr msg)))))
 
 (defvar *context* nil)
 
 ;;;; simple printer service
 
-(defun do-print (msg)
+(defun do-print (ctx msg)
+  (declare (ignore ctx))
   (format t "~&~s~%" msg))
 
 (defclass printer (context)
diff --git a/core/message.lisp b/core/message.lisp
index ee7d33c..8ff0b64 100644
--- a/core/message.lisp
+++ b/core/message.lisp
@@ -4,7 +4,7 @@
   (:use :common-lisp)
   (:local-nicknames (:core :scopes/core))
   (:export #:message #:simple-message
-           #:data))
+           #:head #:data))
 
 (in-package :scopes/core/message)
 
@@ -29,5 +29,5 @@
 (defmethod print-object ((msg message) stream)
   (with-slots (domain action class item) (head msg)
     (format stream 
-            "~&<message (~a ~a ~a ~a) <data ~s>>~%" 
+            "<message (~a ~a ~a ~a) <data ~s>>" 
             domain action class item (data msg))))
diff --git a/test/test-core.lisp b/test/test-core.lisp
index 59ef4f4..c2f81dd 100644
--- a/test/test-core.lisp
+++ b/test/test-core.lisp
@@ -14,10 +14,27 @@
 
 (defvar *config* nil)
 
+;;;; core/testing
+
+(defclass test-rcvr (core:context)
+  ((core:name :initform :test-rcvr)
+   (core:actions :initform
+            (list (make-instance 'core:action-spec
+                                 :handlers (list #'check-message))))
+   (expected :accessor expected :initform (make-hash-table :test #'equalp))))
+
+(defun check-message (ctx msg)
+  (multiple-value-bind (val found) (gethash (message:head msg) (expected ctx))
+    (if (not found)
+      (push (format nil "unexpected: ~s" msg)
+            (t:errors t:*test-suite*)))))
+
+;;;; test runner
+
 (defclass test-suite (t:test-suite)
   ((receiver :reader receiver 
-             :initform (core:printer :test-rcvr))))
-             ;:initform (make-instance 't:test-rcvr))))
+             ;:initform (core:printer :test-rcvr))))
+             :initform (make-instance 'test-rcvr))))
 
 (defun run ()
   (let ((*config* nil)
diff --git a/testing.lisp b/testing.lisp
index 3334bb0..e8b3399 100644
--- a/testing.lisp
+++ b/testing.lisp
@@ -6,7 +6,7 @@
   (:use :common-lisp)
   (:export #:*test-suite*
            #:test-suite #:deftest #:show-result
-           #:test #:==
+           #:errors #:test #:==
            #:test-path #:*current-system*))
 
 (in-package :scopes/testing)