(address . guix-patches@gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20201217153300.19296-1-ludo@gnu.org
* configure.ac: For Guile 2.2, require 2.2.6 or later.
* guix/gexp.scm (define-syntax-parameter-once): Remove.
Use 'define-syntax-parameter' instead.
* guix/mnoads.scm: Likewise.
* guix/inferior.scm (proxy)[select*]: Remove.
* guix/scripts/publish.scm <top level>: Remove replacement for (@@ (web
http) read-header-line).
* guix/store/deduplication.scm (counting-wrapper-port): Remove.
(nar-sha256): Call 'port-position' on PORT to compute SIZE.
---
configure.ac | 2 +-
guix/gexp.scm | 15 ++-------------
guix/inferior.scm | 11 +----------
guix/monads.scm | 15 ++-------------
guix/scripts/publish.scm | 26 --------------------------
guix/store/deduplication.scm | 32 ++++----------------------------
6 files changed, 10 insertions(+), 91 deletions(-)
Toggle diff (190 lines)
diff --git a/configure.ac b/configure.ac
index a5bdf24e93..afb449950f 100644
--- a/configure.ac
+++ b/configure.ac
@@ -102,7 +102,7 @@ if test "x$GUILD" = "x"; then
fi
if test "x$GUILE_EFFECTIVE_VERSION" = "x2.2"; then
- PKG_CHECK_MODULES([GUILE], [guile-2.2 >= 2.2.3])
+ PKG_CHECK_MODULES([GUILE], [guile-2.2 >= 2.2.6])
fi
dnl Get CFLAGS and LDFLAGS for libguile.
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 051831238e..764c89a187 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -1317,18 +1317,7 @@ and in the current monad setting (system type, etc.)"
reference->sexp (gexp-references exp))))
(return (apply (gexp-proc exp) args))))
-(define-syntax-rule (define-syntax-parameter-once name proc)
- ;; Like 'define-syntax-parameter' but ensure the top-level binding for NAME
- ;; does not get redefined. This works around a race condition in a
- ;; multi-threaded context with Guile <= 2.2.4: <https://bugs.gnu.org/27476>.
- (eval-when (load eval expand compile)
- (define name
- (if (module-locally-bound? (current-module) 'name)
- (module-ref (current-module) 'name)
- (make-syntax-transformer 'name 'syntax-parameter
- (list proc))))))
-
-(define-syntax-parameter-once current-imported-modules
+(define-syntax-parameter current-imported-modules
;; Current list of imported modules.
(identifier-syntax '()))
@@ -1339,7 +1328,7 @@ environment."
(identifier-syntax modules)))
body ...))
-(define-syntax-parameter-once current-imported-extensions
+(define-syntax-parameter current-imported-extensions
;; Current list of extensions.
(identifier-syntax '()))
diff --git a/guix/inferior.scm b/guix/inferior.scm
index 77820872b3..2fe91beaab 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -469,22 +469,13 @@ is similar to the sexp returned by 'package-provenance' for regular packages."
"Proxy communication between CLIENT and BACKEND until CLIENT closes the
connection, at which point CLIENT is closed (both CLIENT and BACKEND must be
input/output ports.)"
- (define (select* read write except)
- ;; This is a workaround for <https://bugs.gnu.org/30365> in Guile < 2.2.4:
- ;; since 'select' sometimes returns non-empty sets for no good reason,
- ;; call 'select' a second time with a zero timeout to filter out incorrect
- ;; replies.
- (match (select read write except)
- ((read write except)
- (select read write except 0))))
-
;; Use buffered ports so that 'get-bytevector-some' returns up to the
;; whole buffer like read(2) would--see <https://bugs.gnu.org/30066>.
(setvbuf client 'block 65536)
(setvbuf backend 'block 65536)
(let loop ()
- (match (select* (list client backend) '() '())
+ (match (select (list client backend) '() '())
((reads () ())
(when (memq client reads)
(match (get-bytevector-some client)
diff --git a/guix/monads.scm b/guix/monads.scm
index 6924471345..6ae616aca9 100644
--- a/guix/monads.scm
+++ b/guix/monads.scm
@@ -274,23 +274,12 @@ more optimizations."
(_
#'generic-name))))))))))
-(define-syntax-rule (define-syntax-parameter-once name proc)
- ;; Like 'define-syntax-parameter' but ensure the top-level binding for NAME
- ;; does not get redefined. This works around a race condition in a
- ;; multi-threaded context with Guile <= 2.2.4: <https://bugs.gnu.org/27476>.
- (eval-when (load eval expand compile)
- (define name
- (if (module-locally-bound? (current-module) 'name)
- (module-ref (current-module) 'name)
- (make-syntax-transformer 'name 'syntax-parameter
- (list proc))))))
-
-(define-syntax-parameter-once >>=
+(define-syntax-parameter >>=
;; The name 'bind' is already taken, so we choose this (obscure) symbol.
(lambda (s)
(syntax-violation '>>= ">>= (bind) used outside of 'with-monad'" s)))
-(define-syntax-parameter-once return
+(define-syntax-parameter return
(lambda (s)
(syntax-violation 'return "return used outside of 'with-monad'" s)))
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index c31cef3181..5a865c838d 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -824,32 +824,6 @@ example: \"/foo/bar\" yields '(\"foo\" \"bar\")."
(define %http-write
(@@ (web server http) http-write))
-(match (list (major-version) (minor-version) (micro-version))
- (("2" "2" "5") ;Guile 2.2.5
- (let ()
- (define %read-line (@ (ice-9 rdelim) %read-line))
- (define bad-header (@@ (web http) bad-header))
-
- ;; XXX: Work around <https://bugs.gnu.org/36350> by reverting to the
- ;; definition of 'read-header-line' as found in 2.2.4 and earlier.
- (define (read-header-line port)
- "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.
- (if (string-suffix? "\r" line)
- (string-drop-right line 1)
- line))
- ((line . _) ;EOF or missing delimiter
- (bad-header 'read-header-line line))))
-
- (set! (@@ (web http) read-header-line) read-header-line)))
- (_ #t))
-
(define (strip-headers response)
"Return RESPONSE's headers minus 'Content-Length' and our internal headers."
(fold alist-delete
diff --git a/guix/store/deduplication.scm b/guix/store/deduplication.scm
index a72a43bf79..cd9660174c 100644
--- a/guix/store/deduplication.scm
+++ b/guix/store/deduplication.scm
@@ -37,38 +37,14 @@
dump-file/deduplicate
copy-file/deduplicate))
-;; XXX: This port is used as a workaround on Guile <= 2.2.4 where
-;; 'port-position' throws to 'out-of-range' when the offset is great than or
-;; equal to 2^32: <https://bugs.gnu.org/32161>.
-(define (counting-wrapper-port output-port)
- "Return two values: an output port that wraps OUTPUT-PORT, and a thunk to
-retrieve the number of bytes written to OUTPUT-PORT."
- (let ((byte-count 0))
- (values (make-custom-binary-output-port "counting-wrapper"
- (lambda (bytes offset count)
- (put-bytevector output-port bytes
- offset count)
- (set! byte-count
- (+ byte-count count))
- count)
- (lambda ()
- byte-count)
- #f
- (lambda ()
- (close-port output-port)))
- (lambda ()
- byte-count))))
-
(define (nar-sha256 file)
"Gives the sha256 hash of a file and the size of the file in nar form."
- (let*-values (((port get-hash) (open-sha256-port))
- ((wrapper get-size) (counting-wrapper-port port)))
- (write-file file wrapper)
- (force-output wrapper)
+ (let-values (((port get-hash) (open-sha256-port)))
+ (write-file file port)
(force-output port)
(let ((hash (get-hash))
- (size (get-size)))
- (close-port wrapper)
+ (size (port-position port)))
+ (close-port port)
(values hash size))))
(define (tempname-in directory)
--
2.29.2