mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-11 06:20:23 +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
|
The @code{(ice-9 match)} module also provides the following convenient
|
||||||
syntactic sugar macros wrapping around @code{match}.
|
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
|
Create a procedure of one argument that matches its argument against
|
||||||
each clause, and returns the result of evaluating the corresponding
|
each clause, and returns the result of evaluating the corresponding
|
||||||
expressions.
|
expressions.
|
||||||
|
@ -236,7 +236,7 @@ expressions.
|
||||||
@result{} world
|
@result{} world
|
||||||
@end example
|
@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
|
Create a procedure of any number of arguments that matches its argument
|
||||||
list against each clause, and returns the result of evaluating the
|
list against each clause, and returns the result of evaluating the
|
||||||
corresponding expressions.
|
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")
|
(parse-header 'content-type "text/plain;charset=utf-8")
|
||||||
@result{} (text/plain (charset . "utf-8"))
|
@result{} (text/plain (charset . "utf-8"))
|
||||||
@end example
|
@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 HTTP specification admits this. It specifies the @emph{encoding} of
|
||||||
the characters, not the character set.
|
the characters, not the character set.
|
||||||
@end deftypevr
|
@end deftypevr
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
;;; Ports
|
;;; 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
|
;;; This library is free software: you can redistribute it and/or modify
|
||||||
;;; it under the terms of the GNU Lesser General Public License as
|
;;; it under the terms of the GNU Lesser General Public License as
|
||||||
|
@ -31,6 +31,7 @@
|
||||||
%set-port-property!
|
%set-port-property!
|
||||||
current-input-port current-output-port
|
current-input-port current-output-port
|
||||||
current-error-port current-warning-port
|
current-error-port current-warning-port
|
||||||
|
current-load-port
|
||||||
set-current-input-port set-current-output-port
|
set-current-input-port set-current-output-port
|
||||||
set-current-error-port
|
set-current-error-port
|
||||||
port-mode
|
port-mode
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
;;; HTTP messages
|
;;; 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
|
;; This library is free software; you can redistribute it and/or
|
||||||
;; modify it under the terms of the GNU Lesser General Public
|
;; 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)
|
(lambda (val port)
|
||||||
(put-string port val)))))
|
(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)
|
(define (read-header-line port)
|
||||||
"Read an HTTP header line, including any continuation lines, and
|
"Read an HTTP header line and return it without its final CRLF or LF.
|
||||||
return the combined string without its final CRLF or LF. Raise a
|
Raise a 'bad-header' exception if the line does not end in CRLF or LF,
|
||||||
'bad-header' exception if the line does not end in CRLF or LF, or if EOF
|
or if EOF is reached."
|
||||||
is reached."
|
|
||||||
(match (%read-line port)
|
(match (%read-line port)
|
||||||
(((? string? line) . #\newline)
|
(((? string? line) . #\newline)
|
||||||
;; '%read-line' does not consider #\return a delimiter; so if it's
|
;; '%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
|
;; there, remove it. We are more tolerant than the RFC in that we
|
||||||
;; tolerate LF-only endings.
|
;; tolerate LF-only endings.
|
||||||
(let ((line (if (string-suffix? "\r" line)
|
(if (string-suffix? "\r" line)
|
||||||
(string-drop-right line 1)
|
(string-drop-right line 1)
|
||||||
line)))
|
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)))
|
|
||||||
((line . _) ;EOF or missing delimiter
|
((line . _) ;EOF or missing delimiter
|
||||||
(bad-header 'read-header-line line))))
|
(bad-header 'read-header-line line))))
|
||||||
|
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
;;;; web-http.test --- HTTP library -*- mode: scheme; coding: utf-8; -*-
|
;;;; 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
|
;;;; This library is free software; you can redistribute it and/or
|
||||||
;;;; modify it under the terms of the GNU Lesser General Public
|
;;;; 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")
|
||||||
(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 "close" '(close))
|
||||||
(pass-if-parse connection "Content-Encoding" '(content-encoding))
|
(pass-if-parse connection "Content-Encoding" '(content-encoding))
|
||||||
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue