diff --git a/core/message.lisp b/core/message.lisp index 8ff0b64..285d201 100644 --- a/core/message.lisp +++ b/core/message.lisp @@ -4,16 +4,33 @@ (:use :common-lisp) (:local-nicknames (:core :scopes/core)) (:export #:message #:simple-message - #:head #:data)) + #:head #:data + #:as-list)) (in-package :scopes/core/message) +(defgeneric as-list (obj)) + +;;;; message-head + (defclass message-head () ((domain) (action) (class) (item))) +(defmethod print-object ((head message-head) stream) + (with-slots (domain action class item) head + (format stream + "" + domain action class item))) + +(defmethod as-list ((h message-head)) + (with-slots (domain action class item) h + (list domain action class item))) + +;;;; message + (defclass message () ((head :reader head :initarg :head) (sender) diff --git a/test/test-core.lisp b/test/test-core.lisp index c505421..d4c52d0 100644 --- a/test/test-core.lisp +++ b/test/test-core.lisp @@ -2,7 +2,8 @@ (defpackage :scopes/test-core (:use :common-lisp) - (:local-nicknames (:config :scopes/config) + (:local-nicknames (:alx :alexandria) + (:config :scopes/config) (:core :scopes/core) (:message :scopes/core/message) (:util :scopes/util) @@ -24,13 +25,26 @@ (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*))))) + (let ((key (message:as-list (message:head msg)))) + (multiple-value-bind (val found) (gethash key (expected ctx)) + (if found + (progn + (if (not (equalp (message:data msg) val)) + (push (format nil "no matchhing data: ~s, expected: ~s" msg val) + (t:errors t:*test-suite*))) + (remhash key (expected ctx))) + (push (format nil "unexpected: ~s" msg) + (t:errors t:*test-suite*)))))) (defun expect (ctx msg) - (setf (gethash (message:head msg) (expected ctx)) (message:data msg))) + (setf (gethash (message:as-list (message:head msg)) (expected ctx)) + (message:data msg))) + +(defun check-expected () + (let ((exp (alx:hash-table-keys (expected (receiver t:*test-suite*))))) + (if exp + (push (format nil "unused messages: ~s" exp) + (t:errors t:*test-suite*))))) ;;;; test runner @@ -44,13 +58,16 @@ (t:*test-suite* (make-instance 'test-suite :name "core"))) (load (t:test-path "config-core" "etc")) (test-send) + (check-expected) (t:show-result))) (t:deftest test-send () (let ((rcvr (receiver t:*test-suite*)) - (msg (message:simple-message :test :dummy))) + (msg (message:simple-message :test :dummy)) + (msg-exp (message:simple-message :test :dummy))) (setf (message:data msg) "dummy payload") - (expect rcvr msg) + (setf (message:data msg-exp) "dummy payload") + (expect rcvr msg-exp) (== (core:name rcvr) :test-rcvr) (core:send rcvr msg) ))