wingo pushed a commit to branch wip-whippet
in repository guile.
commit b25e6a51adf3980c1de404535df677709c8b4755
Author: Andy Wingo <[email protected]>
AuthorDate: Wed Jul 16 10:05:48 2025 +0200
Fix (system base types) for ports
* module/system/base/types.scm (inferior-port-type):
(inferior-port): Fix offsets for ptob and name.
* test-suite/tests/types.test ("ports"): Update test expectations now
that bytevector i/o ports are custom ports.
---
module/system/base/types.scm | 12 +++++++-----
test-suite/tests/types.test | 4 ++--
2 files changed, 9 insertions(+), 7 deletions(-)
diff --git a/module/system/base/types.scm b/module/system/base/types.scm
index 5ecdea4cd..54fede9dd 100644
--- a/module/system/base/types.scm
+++ b/module/system/base/types.scm
@@ -323,8 +323,9 @@ TYPE-NUMBER."
"Return an object representing the 'scm_t_port_type' structure at
ADDRESS."
(inferior-object 'port-type
- ;; The 'name' field lives at offset 0.
- (let ((name (dereference-word backend address)))
+ ;; The 'name' field is one word into the ptob.
+ (let ((name (dereference-word backend
+ (+ address %word-size))))
(if (zero? name)
"(nameless)"
(read-c-string backend name)))
@@ -334,9 +335,10 @@ ADDRESS."
"Return an object representing the port at ADDRESS whose type is
TYPE-NUMBER."
(inferior-object 'port
- (let ((address (+ address (* 3 %word-size))))
- (inferior-port-type backend
- (dereference-word backend address)))
+ ;; ptob one word into the port.
+ (let ((ptob (dereference-word backend
+ (+ address %word-size))))
+ (inferior-port-type backend ptob))
address))
(define %visited-cells
diff --git a/test-suite/tests/types.test b/test-suite/tests/types.test
index eeede1308..f4b1dd8ee 100644
--- a/test-suite/tests/types.test
+++ b/test-suite/tests/types.test
@@ -128,8 +128,8 @@
((open-output-file "/dev/null") "file")
((open-input-string "the string") "string")
((open-output-string) "string")
- ((open-bytevector-input-port #vu8(1 2 3 4 5)) "r6rs-bytevector-input-port")
- ((open-bytevector-output-port) "r6rs-bytevector-output-port")))
+ ((open-bytevector-input-port #vu8(1 2 3 4 5)) "custom-port")
+ ((open-bytevector-output-port) "custom-port")))
(define-record-type <some-struct>
(some-struct x y z)
