1
Fork 0
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:
Andy Wingo 2019-08-02 15:30:13 +02:00
commit 8ee6e766b8
5 changed files with 13 additions and 38 deletions

View file

@ -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.

View file

@ -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

View file

@ -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

View file

@ -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))))

View file

@ -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))