cco/cl-scopes
3
0
Fork 0
Code Issues 1 Pull requests Releases Wiki Activity Actions

testing: failure method for simple recording of testing failures

Browse source
This commit is contained in:
Helmut Merz 2024-06-15 17:55:21 +02:00
parent 96ebbe7d0c
commit 8741f50ef6
2 changed files with 14 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
test/test-core.lisp
View file

@ -19,10 +19,12 @@
(defclass test-rcvr (core:context) (defclass test-rcvr (core:context)
((core:name :initform :test-rcvr) ((core:name :initform :test-rcvr)
(core:actions :initform (core:actions
(list (make-instance 'core:action-spec :initform (list
(make-instance 'core:action-spec
:handlers (list #'check-message)))) :handlers (list #'check-message))))
(expected :accessor expected :initform (make-hash-table :test #'equalp)))) (expected :accessor expected
:initform (make-hash-table :test #'equalp))))
(defun check-message (ctx msg) (defun check-message (ctx msg)
(let ((key (message:as-list (message:head msg)))) (let ((key (message:as-list (message:head msg))))
@ -30,11 +32,9 @@
(if found (if found
(progn (progn
(if (not (equalp (message:data msg) val)) (if (not (equalp (message:data msg) val))
(push (format nil "no matchhing data: ~s, expected: ~s" msg val) (t:failure "data mismatch: ~s, expected: ~s" msg val))
(t:errors t:*test-suite*)))
(remhash key (expected ctx))) (remhash key (expected ctx)))
(push (format nil "unexpected: ~s" msg) (t:failure "unexpected: ~s" msg)))))
(t:errors t:*test-suite*))))))
(defun expect (ctx msg) (defun expect (ctx msg)
(setf (gethash (message:as-list (message:head msg)) (expected ctx)) (setf (gethash (message:as-list (message:head msg)) (expected ctx))
@ -43,8 +43,7 @@
(defun check-expected () (defun check-expected ()
(let ((exp (alx:hash-table-keys (expected (receiver t:*test-suite*))))) (let ((exp (alx:hash-table-keys (expected (receiver t:*test-suite*)))))
(if exp (if exp
(push (format nil "unused messages: ~s" exp) (t:failure "unused messages: ~s" exp))))
(t:errors t:*test-suite*)))))
;;;; test runner ;;;; test runner

7
testing.lisp
View file

@ -6,7 +6,7 @@
(:use :common-lisp) (:use :common-lisp)
(:export #:*test-suite* (:export #:*test-suite*
#:test-suite #:deftest #:show-result #:test-suite #:deftest #:show-result
#:errors #:test #:== #:failure #:errors #:test #:==
#:test-path #:*current-system*)) #:test-path #:*current-system*))
(in-package :scopes/testing) (in-package :scopes/testing)
@ -32,12 +32,15 @@
(format t "*** errors: ~a~%" (reverse (errors suite))))) (format t "*** errors: ~a~%" (reverse (errors suite)))))
(values)) (values))
(defun failure (fmt &rest vals)
(push (apply #'format nil fmt vals) (errors *test-suite*)))
(defun == (have wanted) (defun == (have wanted)
(let ((suite *test-suite*) (let ((suite *test-suite*)
(is-ok (equalp have wanted))) (is-ok (equalp have wanted)))
(push is-ok (car (result suite))) (push is-ok (car (result suite)))
(unless is-ok (unless is-ok
(push (format nil "~a!=~a" have wanted) (errors suite))))) (failure "~s!=~s" have wanted))))
(defmacro deftest (name args &body body) (defmacro deftest (name args &body body)
`(defun ,name ,args `(defun ,name ,args