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

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

(in-package :scopes/test-core)

;;;; core/testing: test-receiver

(defclass test-receiver (core:context)
  ((expected :accessor expected 
             :initform (make-hash-table :test #'equalp))))

(defun setup (cfg)
  (core:default-setup cfg 'test-receiver))

(defun check-message (ctx msg)
  (let ((key (message:head-as-list msg)))
    (multiple-value-bind (val found) (gethash key (expected ctx))
      (if found
        (progn
          (if (not (equalp (message:data msg) val))
            (t:failure "data mismatch: ~s, expected: ~s" msg val))
          (remhash key (expected ctx)))
       (t:failure "unexpected: ~s" msg)))))

(defun expect (ctx msg)
  (setf (gethash (message:head-as-list msg) (expected ctx))
        (message:data msg)))

(defun check-expected ()
  (let ((exp (alx:hash-table-keys (expected (receiver t:*test-suite*)))))
    (if exp
      (t:failure "unused messages: ~s" exp))))

;;;; test runner

(defclass test-suite (t:test-suite)
  ((receiver :accessor receiver :initarg :receiver)))

(defun run ()
  (let* ((t:*test-suite* (make-instance 'test-suite :name "core")))
    (load (t:test-path "config-core" "etc"))
    (unwind-protect
      (progn
        (core:setup-services)
        (setf (receiver t:*test-suite*) (core:find-service :test-receiver))
        (test-send))
      (core:shutdown)
      (check-expected)
      (t:show-result))))

(deftest test-send ()
  (let ((rcvr (receiver t:*test-suite*))
        (msg (message:make-message '(:test :dummy) :data "dummy payload"))
        (msg-exp (message:make-message '(:test :dummy) :data "dummy payload")))
    (expect rcvr msg-exp)
    (== (core:name rcvr) :test-receiver)
    (core:send rcvr msg)
    ))