summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/utils.scm34
-rw-r--r--tests/utils.scm6
2 files changed, 38 insertions, 2 deletions
diff --git a/guix/utils.scm b/guix/utils.scm
index 1542e86f7a..7b589e68a8 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -29,7 +29,8 @@
#:use-module (srfi srfi-39)
#:use-module (srfi srfi-60)
#:use-module (rnrs bytevectors)
- #:use-module ((rnrs io ports) #:select (put-bytevector))
+ #:use-module (rnrs io ports)
+ #:use-module ((rnrs bytevectors) #:select (bytevector-u8-set!))
#:use-module ((guix build utils)
#:select (dump-port package-name->name+version))
#:use-module ((guix build syscalls) #:select (errno mkdtemp!))
@@ -90,7 +91,8 @@
decompressed-port
call-with-decompressed-port
compressed-output-port
- call-with-compressed-output-port))
+ call-with-compressed-output-port
+ canonical-newline-port))
;;;
@@ -746,6 +748,34 @@ elements after E."
(if success?
(loop (absolute target) (+ depth 1))
file))))))
+
+(define (canonical-newline-port port)
+ "Return an input port that wraps PORT such that all newlines consist
+ of a single carriage return."
+ (define (get-position)
+ (if (port-has-port-position? port) (port-position port) #f))
+ (define (set-position! position)
+ (if (port-has-set-port-position!? port)
+ (set-port-position! position port)
+ #f))
+ (define (close) (close-port port))
+ (define (read! bv start n)
+ (let loop ((count 0)
+ (byte (get-u8 port)))
+ (cond ((eof-object? byte) count)
+ ((= count (- n 1))
+ (bytevector-u8-set! bv (+ start count) byte)
+ n)
+ ;; XXX: consume all LFs even if not followed by CR.
+ ((eqv? byte (char->integer #\return)) (loop count (get-u8 port)))
+ (else
+ (bytevector-u8-set! bv (+ start count) byte)
+ (loop (+ count 1) (get-u8 port))))))
+ (make-custom-binary-input-port "canonical-newline-port"
+ read!
+ get-position
+ set-position!
+ close))
;;;
;;; Source location.
diff --git a/tests/utils.scm b/tests/utils.scm
index b65d6d20ba..04a859fc9d 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -318,6 +318,12 @@
(string-append (%store-prefix)
"/qvs2rj2ia5vci3wsdb7qvydrmacig4pg-bash-4.2-p24")))
+(test-equal "canonical-newline-port"
+ "This is a journey\nInto the sound\nA journey ...\n"
+ (let ((port (open-string-input-port
+ "This is a journey\r\nInto the sound\r\nA journey ...\n")))
+ (get-string-all (canonical-newline-port port))))
+
(test-end)
(false-if-exception (delete-file temp-file))