Ensure testing HTTP server dies, even post-error

This commit is contained in:
Jaidyn Ann 2024-05-31 12:10:29 -05:00
parent 7807afece2
commit 06890e2395

View File

@ -27,15 +27,21 @@
(asdf:system-relative-pathname :mirror-img/tests path))
(defun run ()
"Run all tests for the mirror-img package."
(let* ((doc-root (relative-pathname "t/testing-website/"))
(acceptor (make-instance 'hunchentoot:easy-acceptor
:port 4242
:document-root doc-root))
(server (hunchentoot:start acceptor)))
(lisp-unit2:with-summary ()
(run-tests :package :mirror-img/tests)
(hunchentoot:stop server))))
(lisp-unit2:with-summary ()
(handler-case
(progn
(run-tests :package :mirror-img/tests)
(hunchentoot:stop server))
(error (c)
(hunchentoot:stop server)
c)))))
(define-test mirror-img (:tags '(mirror-img))
(assert-eq
'T