testing: failure method for simple recording of testing failures
This commit is contained in:
parent
96ebbe7d0c
commit
8741f50ef6
2 changed files with 14 additions and 12 deletions
|
@ -19,10 +19,12 @@
|
|||
|
||||
(defclass test-rcvr (core:context)
|
||||
((core:name :initform :test-rcvr)
|
||||
(core:actions :initform
|
||||
(list (make-instance 'core:action-spec
|
||||
(core:actions
|
||||
:initform (list
|
||||
(make-instance 'core:action-spec
|
||||
: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)
|
||||
(let ((key (message:as-list (message:head msg))))
|
||||
|
@ -30,11 +32,9 @@
|
|||
(if found
|
||||
(progn
|
||||
(if (not (equalp (message:data msg) val))
|
||||
(push (format nil "no matchhing data: ~s, expected: ~s" msg val)
|
||||
(t:errors t:*test-suite*)))
|
||||
(t:failure "data mismatch: ~s, expected: ~s" msg val))
|
||||
(remhash key (expected ctx)))
|
||||
(push (format nil "unexpected: ~s" msg)
|
||||
(t:errors t:*test-suite*))))))
|
||||
(t:failure "unexpected: ~s" msg)))))
|
||||
|
||||
(defun expect (ctx msg)
|
||||
(setf (gethash (message:as-list (message:head msg)) (expected ctx))
|
||||
|
@ -43,8 +43,7 @@
|
|||
(defun check-expected ()
|
||||
(let ((exp (alx:hash-table-keys (expected (receiver t:*test-suite*)))))
|
||||
(if exp
|
||||
(push (format nil "unused messages: ~s" exp)
|
||||
(t:errors t:*test-suite*)))))
|
||||
(t:failure "unused messages: ~s" exp))))
|
||||
|
||||
;;;; test runner
|
||||
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
(:use :common-lisp)
|
||||
(:export #:*test-suite*
|
||||
#:test-suite #:deftest #:show-result
|
||||
#:errors #:test #:==
|
||||
#:failure #:errors #:test #:==
|
||||
#:test-path #:*current-system*))
|
||||
|
||||
(in-package :scopes/testing)
|
||||
|
@ -32,12 +32,15 @@
|
|||
(format t "*** errors: ~a~%" (reverse (errors suite)))))
|
||||
(values))
|
||||
|
||||
(defun failure (fmt &rest vals)
|
||||
(push (apply #'format nil fmt vals) (errors *test-suite*)))
|
||||
|
||||
(defun == (have wanted)
|
||||
(let ((suite *test-suite*)
|
||||
(is-ok (equalp have wanted)))
|
||||
(push is-ok (car (result suite)))
|
||||
(unless is-ok
|
||||
(push (format nil "~a!=~a" have wanted) (errors suite)))))
|
||||
(failure "~s!=~s" have wanted))))
|
||||
|
||||
(defmacro deftest (name args &body body)
|
||||
`(defun ,name ,args
|
||||
|
|
Loading…
Add table
Reference in a new issue