~ chicken-core (master) 19370d8aba2a3e055b2b90fab88284cd20c5df37

commit 19370d8aba2a3e055b2b90fab88284cd20c5df37
Author:     Kristian Lein-Mathisen <kristianlein@gmail.com>
AuthorDate: Wed Aug 26 20:08:05 2026 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Wed Aug 26 21:20:35 2026 +0200

    tests: adds test for make-*-input-port
    
    running these tests on CHICKEN 6.0.0,with a slightly modified callback:
    
        #:read-bytevector
        (lambda (port len bv start)
          (read-bytevector! bv p start (+ start len)))
    
    reveals some problems:
    
        make[-binary]-input-port callbacks:
        make-input-port read sequences:
        (PASS) read-char
        CALLBACK len 2 start 0
        (FAIL) read-string: expected "23" but got "34"
        (FAIL) read-char again: expected #\4 but got #\2
        CALLBACK len 2 start 0
        (PASS) read-bytevector
        CALLBACK len 2 start 0
        (FAIL) read-string : expected "78" but got "89"
        CALLBACK len 1024 start 0
        CALLBACK len 1023 start 1
        (FAIL) read-string: expected "90" but got "0"
    
        make-binary-input-port read sequences:
        (PASS) read-char
        (FAIL) read-string: expected "23" but got ""
        (PASS) read-char again
        (PASS) read-bytevector
        (FAIL) read-string : expected "78" but got ""
        (PASS) read-string
    
    these issues were addressed in commit
    9ad2941f8075e81c9ef3f340b51e586ae5d96844 and all are currently passing
    
    Signed-off-by: felix <felix@call-with-current-continuation.org>

diff --git a/tests/port-tests.scm b/tests/port-tests.scm
index 1962c5eb..1c637a4b 100644
--- a/tests/port-tests.scm
+++ b/tests/port-tests.scm
@@ -344,6 +344,43 @@ EOF
  "read-line string port position tests"
  (test-port-position read-string-line/pos))
 
+;; TODO: include the other documented keyword arguments:
+;;       #:peek-u8 #:peek-char and #:read-line
+(test-group "make[-binary]-input-port callbacks"
+  (let ()
+
+    (define (test-sequence in)
+      (test-equal "read-char"        (read-char in)         #\1)
+      (test-equal "read-string"      (read-string 2 in)     "23")
+      (test-equal "read-char again"  (read-char in)         #\4)
+      (test-equal "read-bytevector"  (read-bytevector 2 in) #u8("56"))
+      (test-equal "read-string "     (read-string 2 in)     "78")
+      (test-equal "read-string"      (read-string #f in)    "90"))
+
+    (test-group "make-input-port read sequences"
+     (test-sequence
+      (let* ((p (open-input-string "1234567890")))
+        (make-input-port
+         (lambda () (read-char p))
+         (lambda () (char-ready? p))
+         (lambda () (close-input-port p))
+         #:peek-u8 #f
+         #:read-bytevector
+         (lambda (bv start end)
+           (read-bytevector! bv p start end))))))
+
+    (test-group "make-binary-input-port read sequences"
+     (test-sequence
+      (let* ((p (open-input-string "1234567890")))
+        (make-binary-input-port
+         (lambda () (read-u8 p))
+         (lambda () (char-ready? p))
+         (lambda () (close-input-port p))
+         #:peek-u8 #f
+         #:read-bytevector
+         (lambda (bv start end)
+           (read-bytevector! bv p start end))))))))
+
 (test-group "read-string!"
   (let ((in (open-input-string "1234567890"))
         (buf (make-string 5)))