;;;; cl-scopes/test-core - testing for the scopes-core system.

(defpackage :scopes/test-core
  (:use :common-lisp)
  (:local-nicknames (:config :scopes/config)
                    (:core :scopes/core)
                    (:message :scopes/core/message)
                    (:util :scopes/util)
                    (:t :scopes/testing))
  (:export #:run #:user #:password)
  (:import-from :scopes/testing #:deftest #:==))

(in-package :scopes/test-core)

(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 'test-rcvr))))

(defun run ()
  (let ((*config* nil)
        (t:*test-suite* (make-instance 'test-suite :name "core")))
    (load (t:test-path "config-core" "etc"))
    (test-send)
    (t:show-result)))

(t:deftest test-send ()
  (let ((rcvr (receiver t:*test-suite*))
        (msg (message:simple-message :test :dummy)))
    (setf (message:data msg) "dummy payload")
    (== (core:name rcvr) :test-rcvr)
    (core:send rcvr msg)
    ))