jadedctrl/ mirror-img
1
0
Disbranĉigi 0
Fontkodo Issues Tirpetoj Activity

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
1 changed files with 9 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
t/mirror-img.lisp
View File

@ -27,15 +27,21 @@
(asdf:system-relative-pathname :mirror-img/tests path)) (asdf:system-relative-pathname :mirror-img/tests path))
(defun run () (defun run ()
"Run all tests for the mirror-img package."
(let* ((doc-root (relative-pathname "t/testing-website/")) (let* ((doc-root (relative-pathname "t/testing-website/"))
(acceptor (make-instance 'hunchentoot:easy-acceptor (acceptor (make-instance 'hunchentoot:easy-acceptor
:port 4242 :port 4242
:document-root doc-root)) :document-root doc-root))
(server (hunchentoot:start acceptor))) (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)) (define-test mirror-img (:tags '(mirror-img))
(assert-eq (assert-eq
'T 'T