diff options
-rw-r--r-- | email/utils.scm | 25 | ||||
-rw-r--r-- | tests/utils.scm | 13 |
2 files changed, 30 insertions, 8 deletions
diff --git a/email/utils.scm b/email/utils.scm index 70153be..984f07e 100644 --- a/email/utils.scm +++ b/email/utils.scm @@ -1,5 +1,5 @@ ;;; guile-email --- Guile email parser -;;; Copyright © 2018, 2019 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2018, 2019, 2020 Arun Isaac <arunisaac@systemreboot.net> ;;; ;;; This file is part of guile-email. ;;; @@ -24,7 +24,7 @@ #:use-module (ice-9 textual-ports) #:use-module (rnrs bytevectors) #:use-module ((rnrs io ports) - #:select (call-with-bytevector-output-port)) + #:select (call-with-port)) #:use-module (rnrs io simple) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) @@ -58,8 +58,14 @@ back into PORT." (read-while-loop output)) (else (unget-string port x))))) - (let ((str (call-with-output-string read-while-loop))) - (if (string-null? str) (eof-object) str))) + (call-with-port (open-output-string) + (lambda (out) + (let ((read-result (read-while-loop out)) + (str (get-output-string out))) + (if (and (eof-object? read-result) + (string-null? str)) + read-result + str))))) (define (read-bytes-till port sequence) "Read bytes from PORT until byte SEQUENCE is seen or end-of-file is @@ -82,9 +88,14 @@ reached. If SEQUENCE is seen, unget it to PORT and return." (else (put-u8 out octet) (read-bytes-and-write-till in out sequence))))) - (let ((bv (call-with-bytevector-output-port - (cut read-bytes-and-write-till port <> sequence)))) - (if (bytevector=? bv (make-bytevector 0)) (eof-object) bv))) + (call-with-values open-bytevector-output-port + (lambda (out get-bytevector) + (let ((read-result (read-bytes-and-write-till port out sequence)) + (bv (get-bytevector))) + (if (and (eof-object? read-result) + (bytevector=? bv #vu8())) + read-result + bv))))) (define (get-line-with-delimiter port) "Read a line from PORT and return it as a string including the diff --git a/tests/utils.scm b/tests/utils.scm index 7681c72..ce8fdb2 100644 --- a/tests/utils.scm +++ b/tests/utils.scm @@ -1,5 +1,5 @@ ;;; guile-email --- Guile email parser -;;; Copyright © 2019 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2019, 2020 Arun Isaac <arunisaac@systemreboot.net> ;;; ;;; This file is part of guile-email. ;;; @@ -35,4 +35,15 @@ (call-with-input-string "" (cut read-while <> read identity)))) +(test-equal "read-bytes-till returns empty bytevector on match at beginning" + (call-with-port (open-bytevector-input-port #vu8(1 2 3)) + (cut read-bytes-till <> #vu8(1 2))) + #vu8()) + +(test-equal "read-while returns empty string on match at beginning" + (call-with-input-string "foo\nbar" + (lambda (port) + (read-while port get-line (negate (cut string-prefix? "foo" <>))))) + "") + (test-end "utils") |