1 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*-
3 ;;; Copyright (c) 2011, Hans Huebner. All rights reserved.
5 ;;; Redistribution and use in source and binary forms, with or without
6 ;;; modification, are permitted provided that the following conditions
9 ;;; * Redistributions of source code must retain the above copyright
10 ;;; notice, this list of conditions and the following disclaimer.
12 ;;; * Redistributions in binary form must reproduce the above
13 ;;; copyright notice, this list of conditions and the following
14 ;;; disclaimer in the documentation and/or other materials
15 ;;; provided with the distribution.
17 ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
18 ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
19 ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
20 ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
21 ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
22 ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
23 ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
24 ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
25 ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
26 ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
27 ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
31 (defparameter *test-port
* 4241)
33 (asdf:oos
'asdf
:load-op
:hunchentoot-test
)
36 (format t
"~&;; Starting web server on localhost:~A." *test-port
*)
38 (let ((server (hunchentoot:start
(make-instance 'hunchentoot
:easy-acceptor
:port
*test-port
*))))
41 (format t
"~&;; Sleeping 2 seconds to give the server some time to start...")
44 (format t
"~&;; Now running confidence tests.")
46 (hunchentoot-test:test-hunchentoot
(format nil
"http://localhost:~A" *test-port
*)))
47 (format t
"~&;; Stopping server.")
49 (hunchentoot:stop server
)
50 (format t
"~&;; Cleaning temporary files.")
51 (hunchentoot-test::clean-tmp-dir
))))
56 ;;; KLUDGE (by Nikodemus Siivola)
58 ;;; SBCL grabs a massive lock in WITH-COMPILATION-UNIT, which ASDF
59 ;;; uses in PERFORM-PLAN ... which makes spawning threads during testing
60 ;;; problematic to say the least.
62 ;;; So, release the world lock for the duration. Nikodemus says that in this
63 ;;; specific usage this should be safe --- and promises that people who copy
64 ;;; this code and use it elsewhere will burn in hell for their sins.
66 ;;; More promisingly, he swears up and down that that massive lock from
67 ;;; W-C-U will be gone by early 2012 at the latest, so this will not be
68 ;;; an eternal kludge, we hope.
69 (defun %call-without-world-lock-kludge
(thunk)
70 #+(and sbcl sb-thread
)
71 (let ((s (find-symbol "**WORLD-LOCK**" :sb-c
)))
72 (if (and s
(boundp s
))
73 (let ((lock (symbol-value s
)))
76 (if (sb-thread:holding-mutex-p lock
)
77 (sb-thread:release-mutex lock
)
81 (sb-thread:grab-mutex lock
))))
83 #-
(and sbcl sb-thread
)
87 (%call-without-world-lock-kludge
'run-tests
)