Improve SRFI-106 tests. Update to using latest (foreign c)

Dockerfile

@@ -41,6 +41,7 @@ WORKDIR /build/foreign-c
 RUN timeout 30 snow-chibi install --impls=${SCHEME} --always-yes "(srfi 64)" || true
 RUN timeout 30 snow-chibi install --impls=${SCHEME} --always-yes "(foreign c)" || true
 RUN timeout 30 snow-chibi install --impls=${SCHEME} --always-yes "(retropikzel shell)" || true
+RUN timeout 30 snow-chibi install --impls=${SCHEME} --always-yes "(retropikzel debug)" || true
 RUN make SCHEME=${SCHEME} build install
 WORKDIR /workdir
 RUN cp -r /build/foreign-c-libraries/retropikzel retropikzel/

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) (foreign c) (srfi ${SRFI}) (srfi 64))" > test-r7rs.scm
+	cd ${TMPDIR} && echo "(import (scheme base) (scheme write) (scheme file) (scheme process-context) (retropikzel debug) (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) (foreign c) (srfi :${SRFI}) (srfi :64))" > test-r6rs.sps
+	cd ${TMPDIR} && echo "(import (rnrs) (retropikzel debug) (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
@@ -57,4 +57,3 @@ tmpdir:
 	rm -rf ${TMPDIR}
 	mkdir -p ${TMPDIR}
 	cp -r srfi ${TMPDIR}/
-	cp -r foreign ${TMPDIR}/

srfi/106.scm

@@ -132,8 +132,8 @@
   (let* ((socket-file-descriptor (c-socket ai-family ai-socktype 0))
          (sockaddr
            (let* ((pointer (make-c-bytevector 128 0))
-                  (pointer-address (c-bytevector->address pointer))
+                  (pointer-address (c-bytevector->integer pointer))
-                  (node-pointer (address->c-bytevector
+                  (node-pointer (integer->c-bytevector
                                   (+ pointer-address *ai-family-size*))))
              (c-bytevector-set! pointer 'u16 0 *af-unix*)
              (c-strcpy node-pointer (string->c-utf8 node))
@@ -212,8 +212,8 @@
          (node "127.0.0.1")
          (sockaddr
            (let* ((pointer (make-c-bytevector 128 0))
-                  (pointer-address (c-bytevector->address pointer))
+                  (pointer-address (c-bytevector->integer pointer))
-                  (node-pointer (address->c-bytevector
+                  (node-pointer (integer->c-bytevector
                                   (+ pointer-address *ai-family-size*))))
              (c-bytevector-set! pointer 'u16 0 *af-inet*)
              (c-bytevector-set! pointer

srfi/106/test.scm

@@ -1,78 +1,75 @@
 
-
+(define sock1-port "3005")
-(display "HERE address-family: ")
+(define sock2-port "3006")
-(write (address-family inet))
-(newline)
-
-(display "HERE address-info: ")
-(write (address-info v4mapped addrconfig))
-(newline)
-
-(display "HERE socket-domain:")
-(write (socket-domain stream))
-(newline)
-
-(display "HERE ip-protocol: ")
-(write (ip-protocol ip))
-(newline)
 
 (define-c-library libc `("stdlib.h") libc-name '((additional-versions ("0" "6"))))
 (define-c-procedure c-system libc 'system 'int '(pointer))
 
-(c-system (string->c-utf8 "echo \"lol\" | nc -l 3001 &"))
+(display "Testing TCP socket")
-
-(define sock1 (make-client-socket "127.0.0.1" "3001"))
-
-(display "HERE sock1: ")
-(write sock1)
 (newline)
 
-(display "HERE sock1 recv: ")
+(debug (address-family inet))
-(write (utf8->string (socket-recv sock1 3)))
+(debug (address-info v4mapped addrconfig))
-(newline)
+(debug (socket-domain stream))
+(debug (ip-protocol ip))
+
+(c-system (string->c-utf8 (string-append "echo \"lol\" | nc -l " sock1-port "&")))
+
+(define sock1 (make-client-socket "127.0.0.1" sock1-port))
+
+(debug sock1)
+(debug (utf8->string (socket-recv sock1 3)))
 
 (socket-send sock1 (string->utf8 "Hello from sock1\n"))
 
 (socket-close sock1)
 
 
-(define sock2-port "3002")
 (define sock2 (make-server-socket sock2-port))
-(display "HERE sock2: ")
+(debug sock2)
-(write sock2)
-(newline)
 
 (display (string-append "run: echo \"lol\" | nc 127.0.0.1 " sock2-port))
 (newline)
 
 (define client-sock1 (socket-accept sock2))
-(display "HERE client-sock1: ")
+(debug client-sock1)
-(write client-sock1)
-(newline)
 
 (socket-send client-sock1 (string->utf8 "Hello from client-sock1\n"))
 
-(display "HERE client-sock1 recv: ")
+(debug (utf8->string (socket-recv client-sock1 3)))
-(write (utf8->string (socket-recv client-sock1 3)))
+
+
+(display "Testing UNIX socket")
 (newline)
 
+(debug (address-family unix))
+(debug (address-info v4mapped addrconfig))
+(debug (socket-domain stream))
+(debug (ip-protocol ip))
+
+(define sock-path "/tmp/demo.sock")
+(c-system (string->c-utf8 (string-append "echo \"lol\" | nc -l -U " sock-path " &")))
+
+(define usock1 (make-client-socket sock-path "3000" *af-unix*))
+
+(debug usock1)
+(debug (utf8->string (socket-recv usock1 3)))
+
+(socket-send usock1 (string->utf8 "Hello from usock1\n"))
+
+(socket-close usock1)
 
 
-#|
+(define usock2-port "")
-(c-system (string->c-utf8 "echo \"lol\" | nc -l -U /tmp/demo.sock &"))
+(define usock2 (make-server-socket usock2-port *af-unix*))
+(debug usock2)
 
-(define sock2 (make-client-socket "/tmp/demo.sock" "3000" *af-unix*))
+(display (string-append "run: echo \"lol\" | nc " sock-path " " usock2-port))
-
-
-(display "HERE sock2: ")
-(write (utf8->string (socket-recv sock2 3)))
 (newline)
 
-(socket-send sock2 (string->utf8 "Hello from sock2\n"))
+(define client-usock1 (socket-accept usock2))
-
+(debug client-usock1)
-(socket-close sock2)
-|#
-
-
 
+(socket-send client-sock1 (string->utf8 "Hello from client-usock1\n"))
 
+(debug (utf8->string (socket-recv client-usock1 3)))