mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-30 06:50:31 +02:00
Code Activity

Merge commit 'a5cbbaa66a'

Browse source
This commit is contained in:
Andy Wingo 2014-02-07 14:43:23 +01:00
commit 7d484bfa15
5 changed files with 18 additions and 31 deletions
Download patch file Download diff file Expand all files Collapse all files

1
THANKS
View file

@ -192,6 +192,7 @@ For fixes or providing information which led to a fix:
Andy Wingo Andy Wingo
Keith Wright Keith Wright
William Xu William Xu
Atom X Zane
;; Local Variables: ;; Local Variables:

2
doc/ref/api-evaluation.texi
View file

@ -238,7 +238,7 @@ comments as specified by R6RS and
@url{http://srfi.schemers.org/srfi-30/srfi-30.html, SRFI-30}: @url{http://srfi.schemers.org/srfi-30/srfi-30.html, SRFI-30}:
@lisp @lisp
(+ #| this is a #| nested |# block comment |# 2) (+ 1 #| this is a #| nested |# block comment |# 2)
@result{} 3 @result{} 3
@end lisp @end lisp

19
module/system/repl/server.scm
View file

@ -67,27 +67,10 @@
(bind sock AF_UNIX path) (bind sock AF_UNIX path)
sock)) sock))
(define call-with-sigint
(if (not (provided? 'posix))
(lambda (thunk) (thunk))
(lambda (thunk)
(let ((handler #f))
(dynamic-wind
(lambda ()
(set! handler
(sigaction SIGINT (lambda (sig) (throw 'interrupt)))))
thunk
(lambda ()
(if handler
;; restore Scheme handler, SIG_IGN or SIG_DFL.
(sigaction SIGINT (car handler) (cdr handler))
;; restore original C handler.
(sigaction SIGINT #f))))))))
(define* (run-server #:optional (server-socket (make-tcp-server-socket))) (define* (run-server #:optional (server-socket (make-tcp-server-socket)))
(define (accept-new-client) (define (accept-new-client)
(catch #t (catch #t
(lambda () (call-with-sigint (lambda () (accept server-socket)))) (lambda () (accept server-socket))
(lambda (k . args) (lambda (k . args)
(cond (cond
((port-closed? server-socket) ((port-closed? server-socket)

8
module/web/http.scm
View file

@ -918,10 +918,10 @@ as an ordered alist."
(define (write-credentials val port) (define (write-credentials val port)
(display (car val) port) (display (car val) port)
(if (pair? (cdr val)) (display #\space port)
(begin (case (car val)
(display #\space port) ((basic) (display (cdr val) port))
(write-key-value-list (cdr val) port)))) (else (write-key-value-list (cdr val) port))))
;; challenges = 1#challenge ;; challenges = 1#challenge
;; challenge = auth-scheme 1*SP 1#auth-param ;; challenge = auth-scheme 1*SP 1#auth-param

19
test-suite/tests/web-http.test
View file

@ -49,14 +49,14 @@
(define-syntax pass-if-round-trip (define-syntax pass-if-round-trip
(syntax-rules () (syntax-rules ()
((_ str) ((_ str)
(pass-if (format #f "~s round trip" str) (pass-if-equal (format #f "~s round trip" str)
(equal? (call-with-output-string str
(lambda (port) (call-with-output-string
(call-with-values (lambda (port)
(lambda () (read-header (open-input-string str))) (call-with-values
(lambda (sym val) (lambda () (read-header (open-input-string str)))
(write-header sym val port))))) (lambda (sym val)
str))))) (write-header sym val port)))))))))
(define-syntax pass-if-any-error (define-syntax pass-if-any-error
(syntax-rules () (syntax-rules ()
@ -292,6 +292,9 @@
(pass-if-parse authorization "Digest foooo" '(digest foooo)) (pass-if-parse authorization "Digest foooo" '(digest foooo))
(pass-if-parse authorization "Digest foo=bar,baz=qux" (pass-if-parse authorization "Digest foo=bar,baz=qux"
'(digest (foo . "bar") (baz . "qux"))) '(digest (foo . "bar") (baz . "qux")))
(pass-if-round-trip "Authorization: basic foooo\r\n")
(pass-if-round-trip "Authorization: digest foooo\r\n")
(pass-if-round-trip "Authorization: digest foo=bar, baz=qux\r\n")
(pass-if-parse expect "100-continue, foo" '((100-continue) (foo))) (pass-if-parse expect "100-continue, foo" '((100-continue) (foo)))
(pass-if-parse from "foo@bar" "foo@bar") (pass-if-parse from "foo@bar" "foo@bar")
(pass-if-parse host "qux" '("qux" . #f)) (pass-if-parse host "qux" '("qux" . #f))