From a8116c47a1cc55fa5d88e612c4139aaf6c385b28 Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau Date: Tue, 17 Oct 2023 05:22:28 +0000 Subject: [PATCH] Test, document and tweak std/misc/ports --- doc/reference/std/misc/ports.md | 23 +++++++- src/std/misc/ports-test.data | 3 + src/std/misc/ports-test.ss | 101 +++++++++++++++++++++++++++++++- src/std/misc/ports.ss | 4 +- 4 files changed, 125 insertions(+), 6 deletions(-) create mode 100644 src/std/misc/ports-test.data diff --git a/doc/reference/std/misc/ports.md b/doc/reference/std/misc/ports.md index 4f87adb07..c19b2898e 100644 --- a/doc/reference/std/misc/ports.md +++ b/doc/reference/std/misc/ports.md @@ -392,8 +392,9 @@ calls the function `f` with that port as argument. The `input-spec` is interpreted as follows: - a port designates itself; - the true value `#t` designates the `(current-input-port)`; -- a string designates a port to be open by passing it to `call-with-output-string`; -- a list designates the settings to pass to `call-with-output-file`; +- a string designates a port to be open by passing it to `call-with-input-string`; +- a u8vector designates a port to be open by passing it to `call-with-input-u8vector`; +- a list designates the settings to pass to `call-with-input-file`; - other values are invalid (a future version of Gerbil might accept additional values). The result returned is that of the call to function `f`. @@ -437,6 +438,24 @@ allowing for seamless resolution of an `input-spec` designator around the inner ``` ::: +## char-port-eof? +```scheme +(char-port-eof? port) -> bool +``` + +`char-port-eof?` is function that given a `port` that is an input-port for characters, +returns `#t` if that port is at the end of file, or else `#f`. + +::: tip Examples: +```scheme +> (call-with-input-string "a" (lambda (port) (let* ((x (char-port-eof? port)) + (y (read-char port)) + (z (char-port-eof? port))) + [x y z]))) +(#f #\a #t) +``` +::: + ## Port Destructor ```scheme (defmethod {destroy } close-port) diff --git a/src/std/misc/ports-test.data b/src/std/misc/ports-test.data new file mode 100644 index 000000000..415d6a3b0 --- /dev/null +++ b/src/std/misc/ports-test.data @@ -0,0 +1,3 @@ +"This test file is used by ports-test.ss" +(Don't remove or modify it ... without fixing the test.) +42 diff --git a/src/std/misc/ports-test.ss b/src/std/misc/ports-test.ss index 7e910c78d..9b2b282cb 100644 --- a/src/std/misc/ports-test.ss +++ b/src/std/misc/ports-test.ss @@ -1,9 +1,104 @@ (export ports-test) (import - :std/error :std/misc/ports :std/test) + :std/error + :std/format + :std/misc/ports + :std/os/temporaries + :std/source + :std/sugar + :std/test) + +(def data-file (this-source-path "ports-test.data")) + +(def test-data +"\"This test file is used by ports-test.ss\" +(Don't remove or modify it ... without fixing the test.) +42 +") +(def test-lines + '("\"This test file is used by ports-test.ss\"" + "(Don't remove or modify it ... without fixing the test.)" + "42")) (def ports-test (test-suite "test :std/misc/ports" - (test-case "trivial port tests" - (check-equal? (with-input (i "foo") (with-output (o #f) (copy-port i o))) "foo")))) + (test-case "copy-port" + (check-equal? (with-input (i "foo") (with-output (o #f) (copy-port i o))) "foo")) + (test-case "read-all-as-string, read-file-string" + (defrule (checks s ...) + (begin (check (call-with-input-string s read-all-as-string) => s) ...)) + (checks "" "hello, world\n" "hello world" "1\n2\n3\r\n4" test-data) + (check (call-with-input-file data-file read-all-as-string) => test-data)) + (test-case "" + (check (read-file-string data-file) => test-data)) + (test-case "read-all-as-lines, read-file-lines" + (defrule (checks (l s . a) ...) + (begin (check (call-with-input-string s (cut read-all-as-lines <> . a)) => l) ...)) + (checks ([] "") + (["hello, world"] "hello, world\n") + (["hello world"] "hello world") + (["1" "2" "3\r" "4"] "1\n2\n3\r\n4") + (["1\n" "2\n" "3\r\n" "4"] "1\n2\n3\r\n4" include-separator?: #t) + (test-lines test-data)) + (check (call-with-input-file data-file read-all-as-lines) => test-lines) + (check (read-file-lines data-file) => test-lines)) + (test-case "read-all-as-u8vector, read-file-u8vector" + (defrule (checks s ...) + (begin (check (bytes->string (call-with-input-u8vector (string->bytes s) read-all-as-u8vector)) + => s) ...)) + (checks "" "hello, world\n" "hello world" "1\n2\n3\r\n4" test-data) + (check (call-with-input-file data-file read-all-as-u8vector) => (string->bytes test-data)) + (check (read-file-u8vector data-file) => (string->bytes test-data))) + #;(test-case "read-password" ...) ;; how do we test that? + (test-case "write-file-string write-file-lines" + (call-with-temporary-file-name + "ports-test" + (lambda (name) + (check (file-exists? name) => #f) + (write-file-string name test-data) + (check (file-exists? name) => #t) + (check (read-file-string name) => test-data) + (check (read-file-lines name) => test-lines))) + (call-with-temporary-file-name + "ports-test" + (lambda (name) + (check (file-exists? name) => #f) + (write-file-lines name test-lines) + (check (file-exists? name) => #t) + (check (read-file-string name) => test-data) + (check (read-file-lines name) => test-lines)))) + (test-case "force-current-outputs writeln" + (call-with-temporary-file-name + "ports-test" + (lambda (name) + (check (file-exists? name) => #f) + (let/cc return + (with-output-to-file name (lambda () (printf "aa") (return)))) + (check (read-file-string name) => "") + (let/cc return + (with-output-to-file name (lambda () (printf "aa") (force-current-outputs) (return)))) + (check (read-file-string name) => "aa") + (let/cc return + (with-output-to-file name (lambda () (writeln 'bb) (return)))) + (check (read-file-string name) => "bb\n") + (let/cc return + (call-with-output-file name (lambda (port) (writeln 'cc port) (return)))) + (check (read-file-string name) => "cc\n")))) + (test-case "output-contents call-with-output with-output call-with-input with-input" + (check (with-output-to-string (cut output-contents test-data)) => test-data) + (check (call-with-output-u8vector (cut output-contents #u8(102 111 111) <>)) => #u8(102 111 111)) + (check (with-input-from-string "foo" + (lambda () + (with-output (o #f) + (with-input (i #t) + (output-contents (cut write (read i) <>) o))))) => "foo") + (check (with-output-to-string + (lambda () + (with-output (o #t) (display "foo" o)))) => "foo")) + (test-case "char-port-eof?" + (call-with-input-string + "a" (lambda (port) + (check (char-port-eof? port) => #f) + (check (read-char port) => #\a) + (check (char-port-eof? port) => #t)))))) diff --git a/src/std/misc/ports.ss b/src/std/misc/ports.ss index b4e581e9e..64e3df470 100644 --- a/src/std/misc/ports.ss +++ b/src/std/misc/ports.ss @@ -346,7 +346,9 @@ ((port? i) (f i)) ((eq? i #t) (f (current-input-port))) ((string? i) (call-with-input-string i f)) - ((list? i) (call-with-input-file i f)))) + ((u8vector? i) (call-with-input-u8vector i f)) + ((list? i) (call-with-input-file i f)) + (else (error "bad call-with-input input" i)))) (defrules with-input () ((_ (i x) body ...) (call-with-input x (lambda (i) body ...)))