From 0cba23d93cdef2422c00e5207c8e2a3fc005f18d Mon Sep 17 00:00:00 2001 From: retropikzel Date: Fri, 27 Feb 2026 11:04:04 +0200 Subject: [PATCH] Update srfi-106 to use newest (foreign c) --- .gitignore | 1 + Makefile | 8 +++----- srfi/106.scm | 50 +++++++++++++++++++++++------------------------ srfi/106/test.scm | 6 ++++-- 4 files changed, 33 insertions(+), 32 deletions(-) diff --git a/.gitignore b/.gitignore index 2662181..6082278 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,4 @@ *.tgz venv *.html +*.log diff --git a/Makefile b/Makefile index f73c059..b050c68 100644 --- a/Makefile +++ b/Makefile @@ -29,11 +29,11 @@ install: uninstall: -snow-chibi remove --impls=${SCHEME} ${PKG} -init-venv: build +run-test-venv: build rm -rf venv scheme-venv ${SCHEME} ${RNRS} venv - echo "(import (scheme base) (scheme write) (scheme read) (scheme char) (scheme file) (scheme process-context) (srfi 64) (srfi ${SRFI}))" > venv/test.scm - printf "#!r6rs\n(import (rnrs) (srfi :64) (srfi :${SRFI}))" > venv/test.sps + echo "(import (scheme base) (scheme write) (scheme read) (scheme char) (scheme file) (scheme process-context) (srfi 64) (foreign c) (srfi ${SRFI}))" > venv/test.scm + printf "#!r6rs\n(import (rnrs) (srfi :64) (foreign c) (srfi :${SRFI}))" > venv/test.sps cat ${TESTFILE} >> venv/test.scm cat ${TESTFILE} >> venv/test.sps if [ "${RNRS}" = "r6rs" ]; then if [ -d ../foreign-c ]; then cp -r ../foreign-c/foreign venv/lib/; fi; fi @@ -46,8 +46,6 @@ init-venv: build if [ "${SCHEME}" = "chicken" ]; then ./venv/bin/snow-chibi install --always-yes srfi.64; fi if [ "${SCHEME}-${RNRS}" = "mosh-r7rs" ]; then ./venv/bin/snow-chibi install --always-yes srfi.64; fi if [ "${RNRS}" = "r7rs" ]; then ./venv/bin/snow-chibi install ${PKG}; fi - -run-test: init-venv if [ "${RNRS}" = "r6rs" ]; then ./venv/bin/scheme-compile venv/test.sps; fi if [ "${RNRS}" = "r7rs" ]; then CSC_OPTIONS="-L -lcurl" ./venv/bin/scheme-compile venv/test.scm; fi ./venv/test diff --git a/srfi/106.scm b/srfi/106.scm index adbb872..6a08391 100644 --- a/srfi/106.scm +++ b/srfi/106.scm @@ -1,5 +1,5 @@ (define-c-library libc - `("sys/types.h" + '("sys/types.h" "sys/socket.h" "sys/un.h" "netinet/in.h" @@ -8,8 +8,8 @@ "fcntl.h" "poll.h" "string.h") - libc-name - '((additional-versions ("0" "6")))) + #f + '()) (define-c-procedure c-socket libc 'socket 'int '(int int int)) (define-c-procedure c-setsockopt libc 'setsockopt 'int '(int int int pointer int)) @@ -103,8 +103,8 @@ (call-with-address-of addrinfo-hints (lambda (addrinfo-hints-address) - (c-getaddrinfo (string->c-utf8 node) - (string->c-utf8 service) + (c-getaddrinfo (string->c-bytevector node) + (string->c-bytevector service) addrinfo-hints addrinfo-address)))))) (socket-file-descriptor @@ -113,13 +113,13 @@ (c-bytevector-ref addrinfo 'int ai-socktype-offset) (c-bytevector-ref addrinfo 'int ai-protocol-offset)))) (when (< addrinfo-result 0) - (c-perror (string->c-utf8 "make-client-socket (addrinfo) error")) + (c-perror (string->c-bytevector "make-client-socket (addrinfo) error")) (raise-continuable "make-client-socket (addrinfo) error")) (when (< socket-file-descriptor 0) - (c-perror (string->c-utf8 "make-client-socket (socket) error")) + (c-perror (string->c-bytevector "make-client-socket (socket) error")) (raise-continuable "make-client-socket (socket) error")) (when (< (c-fcntl socket-file-descriptor F-SETFL O-NONBLOCK) 0) - (c-perror (string->c-utf8 "make-client-socket (fcntl) error")) + (c-perror (string->c-bytevector "make-client-socket (fcntl) error")) (raise-continuable "make-client-socket (fcntl) error")) (letrec* ((ai-addr-offset (* (c-type-size 'int) 6)) (ai-addrlen-offset (* (c-type-size 'int) 4)) @@ -132,7 +132,7 @@ (c-bytevector-set! pollfd 'int 0 0) ;; FIXME No magic numbers, like 8 or 1 here. Put into variable with good name ;; TODO Why 8 works but 1 does not? - (when (= (c-poll pollfd 8 5000) 0) + #;(when (= (c-poll pollfd 8 5000) 0) (error "make-client-socket (poll) error"))) (make-socket socket-file-descriptor)))) @@ -153,7 +153,7 @@ (msg-len (bytevector-length bv)) (sent-count (c-send (socket-file-descriptor socket) msg msg-len 0))) (when (= sent-count -1) - (c-perror (string->c-utf8 "socket-send error")) + (c-perror (string->c-bytevector "socket-send error")) (raise-continuable "socket-send error")) sent-count)) @@ -194,26 +194,26 @@ (c-type-size 'u16) (c-htons (string->number service))) (c-bytevector-set! pointer 'u16 (* (c-type-size 'u16) 2) INADDR-ANY) - ;(c-strcpy node-pointer (string->c-utf8 node)) + ;(c-strcpy node-pointer (string->c-bytevector node)) pointer)) (option (let ((pointer (make-c-bytevector (c-type-size 'int)))) (c-bytevector-set! pointer 'int 0 1) pointer)) (sockaddr-size (+ *ai-family-size* (bytevector-length (string->utf8 node))))) (when (< socket-file-descriptor 0) - (c-perror (string->c-utf8 "make-server-socket (socket) error")) + (c-perror (string->c-bytevector "make-server-socket (socket) error")) (raise-continuable "make-server-socket (socket) error")) (when (< (c-setsockopt socket-file-descriptor SOL-SOCKET SO-REUSEADDR option (c-type-size 'int)) 0) - (c-perror (string->c-utf8 "make-server-socket (setsockopt SO-REUSEADDR) error")) + (c-perror (string->c-bytevector "make-server-socket (setsockopt SO-REUSEADDR) error")) (raise-continuable "make-server-socket (setsockopt SO-REUSEADDR) error")) (when (< (c-setsockopt socket-file-descriptor SOL-SOCKET SO-REUSEPORT option (c-type-size 'int)) 0) - (c-perror (string->c-utf8 "make-server-socket (setsockopt SO-REUSEPORT) error")) + (c-perror (string->c-bytevector "make-server-socket (setsockopt SO-REUSEPORT) error")) (raise-continuable "make-server-socket (setsockopt SO-REUSEPORT) error")) (when (< (c-bind socket-file-descriptor sockaddr *sockaddr-size*) 0) - (c-perror (string->c-utf8 "socket-accept (bind) error")) + (c-perror (string->c-bytevector "socket-accept (bind) error")) (raise-continuable "socket-accept (bind) error")) (when (< (c-listen socket-file-descriptor 0) 0) - (c-perror (string->c-utf8 "make-server-socket (listen) error")) + (c-perror (string->c-bytevector "make-server-socket (listen) error")) (raise-continuable "make-server-socket (listen) error")) (make-socket socket-file-descriptor))) @@ -240,8 +240,8 @@ (call-with-address-of addrinfo-hints (lambda (addrinfo-hints-address) - (c-getaddrinfo (string->c-utf8 "0.0.0.0") - (string->c-utf8 service) + (c-getaddrinfo (string->c-bytevector "0.0.0.0") + (string->c-bytevector service) addrinfo-hints addrinfo-address)))))) (socket-file-descriptor @@ -257,22 +257,22 @@ (ai-addrlen-offset (* (c-type-size 'int) 4)) (ai-addr-len (c-bytevector-ref addrinfo 'int ai-addrlen-offset))) (when (< addrinfo-result 0) - (c-perror (string->c-utf8 "make-server-socket (addrinfo) error")) + (c-perror (string->c-bytevector "make-server-socket (addrinfo) error")) (raise-continuable "make-server-socket (addrinfo) error")) (when (< socket-file-descriptor 0) - (c-perror (string->c-utf8 "make-server-socket (socket) error")) + (c-perror (string->c-bytevector "make-server-socket (socket) error")) (raise-continuable "make-server-socket (socket) error")) (when (< (c-setsockopt socket-file-descriptor SOL-SOCKET SO-REUSEADDR option (c-type-size 'int)) 0) - (c-perror (string->c-utf8 "make-server-socket (setsockopt SO-REUSEADDR) error")) + (c-perror (string->c-bytevector "make-server-socket (setsockopt SO-REUSEADDR) error")) (raise-continuable "make-server-socket (setsockopt SO-REUSEADDR) error")) (when (< (c-setsockopt socket-file-descriptor SOL-SOCKET SO-REUSEPORT option (c-type-size 'int)) 0) - (c-perror (string->c-utf8 "make-server-socket (setsockopt SO-REUSEPORT) error")) + (c-perror (string->c-bytevector "make-server-socket (setsockopt SO-REUSEPORT) error")) (raise-continuable "make-server-socket (setsockopt SO-REUSEPORT) error")) (when (< (c-bind socket-file-descriptor ai-addr ai-addr-len) 0) - (c-perror (string->c-utf8 "make-server-socket (bind) error")) + (c-perror (string->c-bytevector "make-server-socket (bind) error")) (raise-continuable "make-server-socket (bind) error")) (when (< (c-listen socket-file-descriptor 5) 0) - (c-perror (string->c-utf8 "make-server-socket (listen) error")) + (c-perror (string->c-bytevector "make-server-socket (listen) error")) (raise-continuable "make-server-socket (listen) error")) (make-socket socket-file-descriptor)))) @@ -285,7 +285,7 @@ client-sockaddr addrlen))) (when (< accepted-socket 0) - (c-perror (string->c-utf8 "socket-accept (accept) error")) + (c-perror (string->c-bytevector "socket-accept (accept) error")) (raise-continuable "socket-accept (accept) error")) (make-socket accepted-socket))) diff --git a/srfi/106/test.scm b/srfi/106/test.scm index 179dbb3..54ccc51 100644 --- a/srfi/106/test.scm +++ b/srfi/106/test.scm @@ -1,8 +1,9 @@ +(test-begin "srfi-106") (define sock1-port "3005") (define sock2-port "3006") -(define-c-library libc `("stdlib.h") libc-name '((additional-versions ("0" "6")))) +(define-c-library libc `("stdlib.h") #f '()) (define-c-procedure c-system libc 'system 'int '(pointer)) (display "Testing TCP socket") @@ -13,7 +14,7 @@ ;(debug (socket-domain stream)) ;(debug (ip-protocol ip)) -(c-system (string->c-utf8 (string-append "echo \"lol\" | nc -l " sock1-port "&"))) +(c-system (string->c-bytevector (string-append "echo \"lol\" | nc -l " sock1-port "&"))) (define sock1 (make-client-socket "127.0.0.1" sock1-port)) @@ -40,3 +41,4 @@ (write (utf8->string (socket-recv client-sock1 3))) (newline) +(test-end "srfi-106")