;;;; 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) (:shape :scopes/shape) (: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 (shape:head msg))) (multiple-value-bind (val found) (gethash key (expected ctx)) (if found (progn (if (not (equalp (shape: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 (shape:head msg) (expected ctx)) (shape: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 (test-util) (test-record) (core:setup-services) (setf (receiver t:*test-suite*) (core:find-service :test-receiver)) (test-send)) (core:shutdown) (check-expected) (t:show-result)))) (deftest test-util () (== (util:rfill '(1 2 3 4 5) '(a b c)) '(a b c nil nil)) (== (util:rtrim '(1 2 nil 3 nil)) '(1 2 nil 3)) (== (util:to-keyword "hello-kitty") :hello-kitty) (== (util:loop-plist '(:a "a" :b "b") k v collect (string-upcase k)) '("A" "B")) (== (util:plist-pairs '(:a "a" :b "b")) '((:a "a") (:b "b")))) (deftest test-record () (let ((rec (make-instance 'shape:record :head '(:t1)))) (== (shape:head rec) '(:t1 nil)) (== (shape:head-value rec :taskid) :t1) (setf (shape:head-value rec :username) :u1) (== (shape:head-value rec :username) :u1) )) (deftest test-send () (let ((rcvr (receiver t:*test-suite*)) (msg (message:create '(:test :dummy) :data "dummy payload")) (msg-exp (message:create '(:test :dummy) :data "dummy payload"))) (expect rcvr msg-exp) (== (core:name rcvr) :test-receiver) (core:send rcvr msg) ))