diff --git a/core/message.lisp b/core/message.lisp index 285d201..40fcabc 100644 --- a/core/message.lisp +++ b/core/message.lisp @@ -4,8 +4,7 @@ (:use :common-lisp) (:local-nicknames (:core :scopes/core)) (:export #:message #:simple-message - #:head #:data - #:as-list)) + #:head #:data #:head-as-list)) (in-package :scopes/core/message) @@ -19,29 +18,23 @@ (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) (timestamp) - (data :accessor data :initform nil))) + (data :accessor data :initarg :data :initform nil))) -(defun simple-message (&rest head-vals) +(defun simple-message (head-vals &optional data) (let ((h (make-instance 'message-head))) (dolist (sl '(domain action class item)) (setf (slot-value h sl) (pop head-vals))) - (make-instance 'message :head h))) + (make-instance 'message :head h :data data))) + +(defmethod head-as-list ((msg message)) + (with-slots (domain action class item) (head msg) + (list domain action class item))) (defmethod print-object ((msg message) stream) (with-slots (domain action class item) (head msg) diff --git a/test/test-core.lisp b/test/test-core.lisp index 7752870..837747a 100644 --- a/test/test-core.lisp +++ b/test/test-core.lisp @@ -27,7 +27,7 @@ :initform (make-hash-table :test #'equalp)))) (defun check-message (ctx msg) - (let ((key (message:as-list (message:head msg)))) + (let ((key (message:head-as-list msg))) (multiple-value-bind (val found) (gethash key (expected ctx)) (if found (progn @@ -37,7 +37,7 @@ (t:failure "unexpected: ~s" msg))))) (defun expect (ctx msg) - (setf (gethash (message:as-list (message:head msg)) (expected ctx)) + (setf (gethash (message:head-as-list msg) (expected ctx)) (message:data msg))) (defun check-expected () @@ -62,10 +62,8 @@ (t:deftest test-send () (let ((rcvr (receiver t:*test-suite*)) - (msg (message:simple-message :test :dummy)) - (msg-exp (message:simple-message :test :dummy))) - (setf (message:data msg) "dummy payload") - (setf (message:data msg-exp) "dummy payload") + (msg (message:simple-message '(:test :dummy) "dummy payload")) + (msg-exp (message:simple-message '(:test :dummy) "dummy payload"))) (expect rcvr msg-exp) (== (core:name rcvr) :test-rcvr) (core:send rcvr msg) diff --git a/testing.lisp b/testing.lisp index 370d92f..123632b 100644 --- a/testing.lisp +++ b/testing.lisp @@ -6,7 +6,7 @@ (:use :common-lisp) (:export #:*test-suite* #:test-suite #:deftest #:show-result - #:failure #:errors #:test #:== + #:failure #:test #:== #:test-path #:*current-system*)) (in-package :scopes/testing)