From 5de156823d0e00b96ffa1e54903f3d6b8cce78ba Mon Sep 17 00:00:00 2001
From: retropikzel <retropikzel@iki.fi>
Date: Tue, 30 Dec 2025 19:03:04 +0200
Subject: [PATCH] Improve tests, add socket close

---
 Makefile          |  4 ++--
 srfi/106.scm      |  8 ++++++++
 srfi/106.sld      |  2 +-
 srfi/106/test.scm | 30 ++++++++++++++++++++++++------
 4 files changed, 35 insertions(+), 9 deletions(-)

diff --git a/Makefile b/Makefile
index f9ba42d..817d0b7 100644
--- a/Makefile
+++ b/Makefile
@@ -33,7 +33,7 @@ uninstall:
 
 test-r7rs: tmpdir
 	@if [ "${SCHEME}" = "chibi" ]; then rm -rf ${TMPDIR}/srfi/98.*; fi
-	cd ${TMPDIR} && echo "(import (scheme base) (scheme write) (scheme file) (scheme process-context) (srfi ${SRFI}) (srfi 64))" > test-r7rs.scm
+	cd ${TMPDIR} && echo "(import (scheme base) (scheme write) (scheme file) (scheme process-context) (foreign c) (srfi ${SRFI}) (srfi 64))" > test-r7rs.scm
 	cd ${TMPDIR} && cat srfi/${SRFI}/test.scm >> test-r7rs.scm
 	cd ${TMPDIR} && COMPILE_R7RS=${SCHEME} compile-scheme -I . -o test-r7rs test-r7rs.scm
 	cd ${TMPDIR} && printf "\n" | ./test-r7rs
@@ -43,7 +43,7 @@ test-r7rs-docker:
 	docker run -t foreign-c-srfi-test-${SCHEME} sh -c "make SCHEME=${SCHEME} SRFI=${SRFI} SNOW_CHIBI_ARGS=--always-yes build install test-r7rs"
 
 test-r6rs: tmpdir
-	cd ${TMPDIR} && echo "(import (rnrs) (srfi :${SRFI}) (srfi :64))" > test-r6rs.sps
+	cd ${TMPDIR} && echo "(import (rnrs) (foreign c) (srfi :${SRFI}) (srfi :64))" > test-r6rs.sps
 	cd ${TMPDIR} && cat srfi/${SRFI}/test.scm >> test-r6rs.sps
 	cd ${TMPDIR} && akku install chez-srfi akku-r7rs "(foreign c)" #"(retropikzel shell)"
 	cd ${TMPDIR} && COMPILE_R7RS=${SCHEME} compile-scheme -I .akku/lib -o test-r6rs test-r6rs.sps
diff --git a/srfi/106.scm b/srfi/106.scm
index 73f03dd..a94e2af 100644
--- a/srfi/106.scm
+++ b/srfi/106.scm
@@ -20,6 +20,7 @@
 (define-c-procedure c-read libc 'read 'int '(int pointer int))
 (define-c-procedure c-poll libc 'poll 'int '(pointer int int))
 (define-c-procedure c-strcpy libc 'strcpy 'int '(pointer pointer))
+(define-c-procedure c-close libc 'close 'int '(int))
 
 
 (define-record-type <socket>
@@ -215,3 +216,10 @@
                      (apply message-type flags)))
          (bytes-pointer (make-c-bytevector size 0)))
     (socket-recv-loop socket bytes-pointer size)))
+
+(define (socket-close socket)
+  (when (not (socket? socket))
+    (error "socket-close: Not a socket" socket))
+  (c-close (socket-file-descriptor socket)))
+
+
diff --git a/srfi/106.sld b/srfi/106.sld
index 28ed46c..3fabb29 100644
--- a/srfi/106.sld
+++ b/srfi/106.sld
@@ -11,7 +11,7 @@
           socket-send
           socket-recv
           ;socket-shutdown
-          ;socket-close
+          socket-close
           ;socket-input-port
           ;socket-output-port
           ;call-with-socket
diff --git a/srfi/106/test.scm b/srfi/106/test.scm
index b11ee25..66368b3 100644
--- a/srfi/106/test.scm
+++ b/srfi/106/test.scm
@@ -1,12 +1,30 @@
 
-(define client-socket (make-client-socket "127.0.0.1" "3000"))
-;(define client-socket (make-client-socket "/tmp/demo.sock" "3000" *af-unix*))
+(define-c-library libc `("stdlib.h") libc-name '((additional-versions ("0" "6"))))
+(define-c-procedure c-system libc 'system 'int '(pointer))
 
-(socket-send client-socket (string->utf8 "Hello from test"))
 
-(display "HERE: ")
-(write (utf8->string (socket-recv client-socket 5)))
+(c-system (string->c-utf8 "echo \"lol\" | nc -l 3000 &"))
+
+(define sock1 (make-client-socket "127.0.0.1" "3000"))
+
+(display "HERE sock1: ")
+(write (utf8->string (socket-recv sock1 3)))
 (newline)
 
-(write client-socket)
+(socket-send sock1 (string->utf8 "Hello from sock1\n"))
+
+(socket-close sock1)
+
+
+(c-system (string->c-utf8 "echo \"lol\" | nc -l -U /tmp/demo.sock &"))
+
+(define sock2 (make-client-socket "/tmp/demo.sock" "3000" *af-unix*))
+
+
+(display "HERE sock2: ")
+(write (utf8->string (socket-recv sock2 3)))
 (newline)
+
+(socket-send sock2 (string->utf8 "Hello from sock2\n"))
+
+(socket-close sock2)