mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-09 21:40:33 +02:00
Merge from stable-2.2
This commit is contained in:
commit
8ee6e766b8
5 changed files with 13 additions and 38 deletions
|
@ -216,7 +216,7 @@ one-element list containing a @var{person} whose first slot is
|
|||
The @code{(ice-9 match)} module also provides the following convenient
|
||||
syntactic sugar macros wrapping around @code{match}.
|
||||
|
||||
@deffn {Scheme Syntax} match-lambda exp clause1 clause2 @dots{}
|
||||
@deffn {Scheme Syntax} match-lambda clause1 clause2 @dots{}
|
||||
Create a procedure of one argument that matches its argument against
|
||||
each clause, and returns the result of evaluating the corresponding
|
||||
expressions.
|
||||
|
@ -236,7 +236,7 @@ expressions.
|
|||
@result{} world
|
||||
@end example
|
||||
|
||||
@deffn {Scheme Syntax} match-lambda* exp clause1 clause2 @dots{}
|
||||
@deffn {Scheme Syntax} match-lambda* clause1 clause2 @dots{}
|
||||
Create a procedure of any number of arguments that matches its argument
|
||||
list against each clause, and returns the result of evaluating the
|
||||
corresponding expressions.
|
||||
|
|
|
@ -791,7 +791,7 @@ The MIME type of a resource, as a symbol, along with any parameters.
|
|||
(parse-header 'content-type "text/plain;charset=utf-8")
|
||||
@result{} (text/plain (charset . "utf-8"))
|
||||
@end example
|
||||
Note that the @code{charset} parameter is something is a misnomer, and
|
||||
Note that the @code{charset} parameter is something of a misnomer, and
|
||||
the HTTP specification admits this. It specifies the @emph{encoding} of
|
||||
the characters, not the character set.
|
||||
@end deftypevr
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
;;; Ports
|
||||
;;; Copyright (C) 2016 Free Software Foundation, Inc.
|
||||
;;; Copyright (C) 2016, 2019 Free Software Foundation, Inc.
|
||||
;;;
|
||||
;;; This library is free software: you can redistribute it and/or modify
|
||||
;;; it under the terms of the GNU Lesser General Public License as
|
||||
|
@ -31,6 +31,7 @@
|
|||
%set-port-property!
|
||||
current-input-port current-output-port
|
||||
current-error-port current-warning-port
|
||||
current-load-port
|
||||
set-current-input-port set-current-output-port
|
||||
set-current-error-port
|
||||
port-mode
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
;;; HTTP messages
|
||||
|
||||
;; Copyright (C) 2010-2017, 2019 Free Software Foundation, Inc.
|
||||
;; Copyright (C) 2010-2017 Free Software Foundation, Inc.
|
||||
|
||||
;; This library is free software; you can redistribute it and/or
|
||||
;; modify it under the terms of the GNU Lesser General Public
|
||||
|
@ -152,35 +152,18 @@ The default writer will call ‘put-string’."
|
|||
(lambda (val port)
|
||||
(put-string port val)))))
|
||||
|
||||
(define spaces-and-tabs
|
||||
(char-set #\space #\tab))
|
||||
|
||||
(define (space-or-tab? c)
|
||||
(case c
|
||||
((#\space #\tab) #t)
|
||||
(else #f)))
|
||||
|
||||
(define (read-header-line port)
|
||||
"Read an HTTP header line, including any continuation lines, and
|
||||
return the combined string without its final CRLF or LF. Raise a
|
||||
'bad-header' exception if the line does not end in CRLF or LF, or if EOF
|
||||
is reached."
|
||||
"Read an HTTP header line and return it without its final CRLF or LF.
|
||||
Raise a 'bad-header' exception if the line does not end in CRLF or LF,
|
||||
or if EOF is reached."
|
||||
(match (%read-line port)
|
||||
(((? string? line) . #\newline)
|
||||
;; '%read-line' does not consider #\return a delimiter; so if it's
|
||||
;; there, remove it. We are more tolerant than the RFC in that we
|
||||
;; tolerate LF-only endings.
|
||||
(let ((line (if (string-suffix? "\r" line)
|
||||
(string-drop-right line 1)
|
||||
line)))
|
||||
;; If the next character is a space or tab, then there's at least
|
||||
;; one continuation line. Read the continuation lines by calling
|
||||
;; 'read-header-line' recursively, and append them to this header
|
||||
;; line, folding the leading spaces and tabs to a single space.
|
||||
(if (space-or-tab? (lookahead-char port))
|
||||
(string-append line " " (string-trim (read-header-line port)
|
||||
spaces-and-tabs))
|
||||
line)))
|
||||
(if (string-suffix? "\r" line)
|
||||
(string-drop-right line 1)
|
||||
line))
|
||||
((line . _) ;EOF or missing delimiter
|
||||
(bad-header 'read-header-line line))))
|
||||
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
;;;; web-http.test --- HTTP library -*- mode: scheme; coding: utf-8; -*-
|
||||
;;;;
|
||||
;;;; Copyright (C) 2010-2011, 2014-2017, 2019 Free Software Foundation, Inc.
|
||||
;;;; Copyright (C) 2010-2011, 2014-2017 Free Software Foundation, Inc.
|
||||
;;;;
|
||||
;;;; This library is free software; you can redistribute it and/or
|
||||
;;;; modify it under the terms of the GNU Lesser General Public
|
||||
|
@ -242,15 +242,6 @@
|
|||
(pass-if-round-trip "Cache-Control: acme-cache-extension=100 quux\r\n")
|
||||
(pass-if-round-trip "Cache-Control: acme-cache-extension=\"100, quux\"\r\n")
|
||||
|
||||
(let ((str "Cache-Control: acme-cache-extension=\"100,\r\n\t foo,\r\n quux\"\r\n")
|
||||
(val '(cache-control . ((acme-cache-extension . "100, foo, quux")))))
|
||||
(pass-if-equal "continuation lines"
|
||||
val
|
||||
(call-with-values (lambda ()
|
||||
(read-header (open-input-string str)))
|
||||
(lambda (sym val)
|
||||
(cons sym val)))))
|
||||
|
||||
(pass-if-parse connection "close" '(close))
|
||||
(pass-if-parse connection "Content-Encoding" '(content-encoding))
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue