wingo pushed a commit to branch wip-whippet
in repository guile.
commit 4c2a8c1dd300d8bb69190caf19729ec7b8104deb
Author: Andy Wingo <wi...@pobox.com>
AuthorDate: Mon May 5 11:45:31 2025 +0200
Update tests to use new soft ports interface.
* test-suite/tests/r6rs-ports.test:
* test-suite/tests/web-client.test:
* test-suite/tests/ports.test ("pending EOF behavior"):
("unicode byte-order marks (BOMs)"): Use new soft ports.
---
test-suite/tests/ports.test | 25 +++++--------
test-suite/tests/r6rs-ports.test | 77 +++++++++++++++++-----------------------
test-suite/tests/web-client.test | 18 +++++-----
3 files changed, 50 insertions(+), 70 deletions(-)
diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
index 82881aa28..651007e97 100644
--- a/test-suite/tests/ports.test
+++ b/test-suite/tests/ports.test
@@ -23,6 +23,7 @@
#:use-module (test-suite guile-test)
#:use-module (ice-9 popen)
#:use-module (ice-9 rdelim)
+ #:use-module (ice-9 soft-ports)
#:use-module (ice-9 threads)
#:use-module (rnrs bytevectors)
#:use-module ((ice-9 binary-ports) #:select (open-bytevector-input-port
@@ -1598,16 +1599,11 @@
;; Make a test port that will produce the given sequence. Each
;; element of 'lst' may be either a character or #f (which means EOF).
(define (test-soft-port . lst)
- (make-soft-port
- (vector (lambda (c) #f) ; write char
- (lambda (s) #f) ; write string
- (lambda () #f) ; flush
- (lambda () ; read char
- (let ((c (car lst)))
- (set! lst (cdr lst))
- c))
- (lambda () #f)) ; close
- "rw"))
+ (make-soft-port #:read-string
+ (lambda ()
+ (let ((c (car lst)))
+ (set! lst (cdr lst))
+ (if c (string c) "")))))
(define (call-with-port p proc)
(dynamic-wind
@@ -1811,13 +1807,8 @@
(pass-if "Don't read from the port unless user asks to"
(let* ((p (make-soft-port
- (vector
- (lambda (c) #f) ; write char
- (lambda (s) #f) ; write string
- (lambda () #f) ; flush
- (lambda () (throw 'fail)) ; read char
- (lambda () #f))
- "rw")))
+ #:write-string (lambda (str) #t)
+ #:read-string (lambda () (throw 'fail)))))
(set-port-encoding! p "UTF-16")
(display "abc" p)
(set-port-encoding! p "UTF-32")
diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test
index c782b65f3..7332388c0 100644
--- a/test-suite/tests/r6rs-ports.test
+++ b/test-suite/tests/r6rs-ports.test
@@ -1,6 +1,6 @@
;;;; r6rs-ports.test --- R6RS I/O port tests. -*- coding: utf-8; -*-
;;;;
-;;;; Copyright (C) 2009-2012,2013-2015,2018-2021,2023,2024-2024 Free Software
Foundation, Inc.
+;;;; Copyright (C) 2009-2012,2013-2015,2018-2021,2023,2024-2025 Free Software
Foundation, Inc.
;;;; Ludovic Courtès
;;;;
;;;; This library is free software; you can redistribute it and/or
@@ -23,6 +23,7 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (ice-9 match)
+ #:use-module (ice-9 soft-ports)
#:use-module ((ice-9 binary-ports) #:select (get-bytevector-some!))
#:use-module (rnrs io ports)
#:use-module (rnrs io simple)
@@ -56,17 +57,16 @@
(define (write-char chr)
(set! write-index (+ 1 write-index))
(maybe-fail write-index ENOSPC))
- (make-soft-port
- (vector write-char
- (lambda (str) ;; write-string
- (for-each write-char (string->list str)))
- (lambda () #t) ;; flush-output
- (lambda () ;; read-char
- (set! read-index (+ read-index 1))
- (maybe-fail read-index EIO)
- #\space)
- (lambda () #t)) ;; close-port
- "rw")))
+ (define port
+ (make-soft-port
+ #:write-string (lambda (str)
+ (for-each write-char (string->list str)))
+ #:read-string (lambda ()
+ (set! read-index (+ read-index 1))
+ (maybe-fail read-index EIO)
+ " ")))
+ (setvbuf port 'none)
+ port))
(define (call-with-bytevector-output-port/transcoded transcoder receiver)
(call-with-bytevector-output-port
@@ -206,26 +206,13 @@
(pass-if "get-bytevector-all"
(let* ((str "GNU Guile")
(index 0)
- (port (make-soft-port
- (vector #f #f #f
- (lambda ()
- (if (>= index (string-length str))
- (eof-object)
- (let ((c (string-ref str index)))
- (set! index (+ index 1))
- c)))
- (lambda () #t)
- (let ((cont? #f))
- (lambda ()
- ;; Number of readily available octets: falls to
- ;; zero after 4 octets have been read and then
- ;; starts again.
- (let ((a (if cont?
- (- (string-length str) index)
- (- 4 (modulo index 5)))))
- (if (= 0 a) (set! cont? #t))
- a))))
- "r"))
+ (port (make-soft-port #:read-string
+ (lambda ()
+ (if (< index (string-length str))
+ (let ((c (string-ref str index)))
+ (set! index (+ index 1))
+ (string c))
+ ""))))
(bv (get-bytevector-all port)))
(and (bytevector? bv)
(= index (string-length str))
@@ -242,19 +229,19 @@
(bytevector-u8-set! bv write-index
(char->integer chr))
(set! write-index (+ 1 write-index)))))
- (make-soft-port
- (vector write-char
- (lambda (str) ;; write-string
- (for-each write-char (string->list str)))
- (lambda () #t) ;; flush-output
- (lambda () ;; read-char
- (if (>= read-index (bytevector-length bv))
- (eof-object)
- (let ((c (bytevector-u8-ref bv read-index)))
- (set! read-index (+ read-index 1))
- (integer->char c))))
- (lambda () #t)) ;; close-port
- "rw")))
+ (define port
+ (make-soft-port
+ #:write-string
+ (lambda (str) (for-each write-char (string->list str)))
+ #:read-string
+ (lambda ()
+ (if (>= read-index (bytevector-length bv))
+ ""
+ (let ((c (bytevector-u8-ref bv read-index)))
+ (set! read-index (+ read-index 1))
+ (string (integer->char c)))))))
+ (setvbuf port 'none)
+ port))
(with-test-prefix "8.2.11 Binary Output"
diff --git a/test-suite/tests/web-client.test b/test-suite/tests/web-client.test
index 805baa9e9..d9178964b 100644
--- a/test-suite/tests/web-client.test
+++ b/test-suite/tests/web-client.test
@@ -1,6 +1,6 @@
;;;; web-client.test --- HTTP client -*- mode: scheme; coding: utf-8; -*-
;;;;
-;;;; Copyright (C) 2013 Free Software Foundation, Inc.
+;;;; Copyright (C) 2013, 2025 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -23,6 +23,7 @@
#:use-module (web response)
#:use-module (ice-9 iconv)
#:use-module (ice-9 binary-ports)
+ #:use-module (ice-9 soft-ports)
#:use-module (test-suite lib))
@@ -470,7 +471,7 @@ Connection: close\r
(unless writing?
(error "Port closed for writing"))
(put-u8 request-port (char->integer c)))
- (define (put-string s)
+ (define (write-string s)
(string-for-each put-char s)
(set! writing? #f)
(set! reading? #t)
@@ -485,23 +486,24 @@ Connection: close\r
(equal? (or actual-body #vu8())
(string->bytevector expected-request-body
request-body-encoding)))))
- (define (get-char)
+ (define (read-string)
(unless reading?
(error "Port closed for reading"))
(let ((c (read-char response-port)))
(if (char? c)
- c
+ (string c)
(let ((u8 (get-u8 response-body-port)))
(if (eof-object? u8)
- u8
- (integer->char u8))))))
+ ""
+ (string (integer->char u8)))))))
(define (close)
(when writing?
(unless (eof-object? (get-u8 response-body-port))
(error "Failed to consume all of body"))))
(let ((soft-port (make-soft-port
- (vector put-char put-string #f get-char close)
- "rw")))
+ #:write-string write-string
+ #:read-string read-string
+ #:close close)))
;; Arrange it so that the only time our put-char/put-string
;; functions are called is during force-output.
(setvbuf soft-port 'block 10000)
