scopes/core: some minor improvements, e.g. optionally provide data in message creation

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 
-            "<message-head (~a ~a ~a ~a)>"
-            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)

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)

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)