Better handle the web server exception handler not returning 2 values
This commit is contained in:
parent
f41d1853ce
commit
a6c96aa1da
2 changed files with 68 additions and 1 deletions
|
@ -273,7 +273,33 @@ on the procedure being called at any particular time."
|
|||
(call-with-values
|
||||
(lambda ()
|
||||
(exception-handler exn request))
|
||||
(match-lambda*
|
||||
((response body)
|
||||
(call-with-values
|
||||
(lambda ()
|
||||
(sanitize-response request response body))
|
||||
return))
|
||||
(other
|
||||
(call-with-values
|
||||
(lambda ()
|
||||
(default-exception-handler
|
||||
(make-exception-with-irritants
|
||||
(list (make-exception-with-message
|
||||
(simple-format
|
||||
#f
|
||||
"wrong number of values returned from exception handler, expecting 2, got ~A"
|
||||
(length other)))
|
||||
exception-handler))
|
||||
request))
|
||||
(match-lambda*
|
||||
((response body)
|
||||
(call-with-values
|
||||
(lambda ()
|
||||
(sanitize-response
|
||||
request
|
||||
response
|
||||
body))
|
||||
return))))))))
|
||||
(lambda ()
|
||||
(start-stack
|
||||
#t
|
||||
|
|
|
@ -33,6 +33,47 @@
|
|||
uri
|
||||
#:port (non-blocking-open-socket-for-uri uri)))))))
|
||||
|
||||
(run-fibers-for-tests
|
||||
(lambda ()
|
||||
(let* ((web-server
|
||||
(run-knots-web-server
|
||||
(lambda (request)
|
||||
"Hello, World!")
|
||||
#:port 0)) ;; Bind to any port
|
||||
(port
|
||||
(web-server-port web-server))
|
||||
(uri
|
||||
(build-uri 'http #:host "127.0.0.1" #:port port)))
|
||||
|
||||
(assert-equal
|
||||
500
|
||||
(response-code
|
||||
(http-get
|
||||
uri
|
||||
#:port (non-blocking-open-socket-for-uri uri)))))))
|
||||
|
||||
(run-fibers-for-tests
|
||||
(lambda ()
|
||||
(let* ((web-server
|
||||
(run-knots-web-server
|
||||
(lambda (request)
|
||||
"Hello, World!")
|
||||
#:port 0
|
||||
#:exception-handler
|
||||
(lambda (exn request)
|
||||
"Error"))) ;; Bind to any port
|
||||
(port
|
||||
(web-server-port web-server))
|
||||
(uri
|
||||
(build-uri 'http #:host "127.0.0.1" #:port port)))
|
||||
|
||||
(assert-equal
|
||||
500
|
||||
(response-code
|
||||
(http-get
|
||||
uri
|
||||
#:port (non-blocking-open-socket-for-uri uri)))))))
|
||||
|
||||
(run-fibers-for-tests
|
||||
(lambda ()
|
||||
(let* ((web-server
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue