work in progress: test receiver

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)

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))))

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)

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)