From 7237a5164317a0c199bc902f11cb02c918a153ff Mon Sep 17 00:00:00 2001
From: retropikzel <retropikzel@iki.fi>
Date: Sun, 1 Feb 2026 06:22:37 +0200
Subject: [PATCH] Improve testing. Fix bug in named-pipes

---
 .gitignore                      |  1 +
 Makefile                        | 18 ++++++++++++++++++
 retropikzel/named-pipes.scm     | 10 +++++++---
 retropikzel/named-pipes/VERSION |  2 +-
 4 files changed, 27 insertions(+), 4 deletions(-)

diff --git a/.gitignore b/.gitignore
index d5e03b2..bc59b0f 100644
--- a/.gitignore
+++ b/.gitignore
@@ -22,3 +22,4 @@ test-r7rs
 example.scm
 example.sps
 example
+venv
diff --git a/Makefile b/Makefile
index b1aa1c8..d403d7a 100644
--- a/Makefile
+++ b/Makefile
@@ -1,6 +1,7 @@
 .SILENT: build install test-r6rs test-r6rs-docker test-r7rs test-r7rs-docker clean
 .PHONY: test-r6rs test-r7rs example.scm example.sps
 SCHEME=chibi
+RNRS=r7rs
 LIBRARY=system
 EXAMPLE=editor
 EXAMPLE_FILE=retropikzel/${LIBRARY}/examples/${EXAMPLE}
@@ -31,6 +32,23 @@ install:
 uninstall:
 	-snow-chibi remove --impls=${SCHEME} ${PKG}
 
+init-venv: build
+	rm -rf venv
+	scheme-venv ${SCHEME} ${RNRS} venv
+	cp ${TESTFILE} venv/test.scm
+	cp ${TESTFILE} venv/test.sps
+	sed -i 's/srfi 64/srfi :64/' venv/test.sps
+	cp -r ../foreign-c/foreign venv/lib
+	cp -r retropikzel venv/lib/
+	if [ "${RNRS}" = "r7rs" ]; then ./venv/bin/snow-chibi install --always-yes srfi.64; fi
+	if [ "${RNRS}" = "r7rs" ]; then ./venv/bin/snow-chibi install --always-yes ${PKG}; fi
+	./venv/bin/akku install akku-r7rs chez-srfi
+
+run-test: init-venv
+	if [ "${RNRS}" = "r6rs" ]; then ./venv/bin/scheme-compile venv/test.sps; fi
+	if [ "${RNRS}" = "r7rs" ]; then ./venv/bin/scheme-compile venv/test.scm; fi
+	./venv/test
+
 test-r7rs:
 	echo "(import (scheme base) (scheme write) (scheme file) (scheme process-context) (foreign c) (retropikzel ${LIBRARY}) (srfi 64))" > test-r7rs.scm
 	cat retropikzel/${LIBRARY}/test.scm >> test-r7rs.scm
diff --git a/retropikzel/named-pipes.scm b/retropikzel/named-pipes.scm
index c980990..9c04d54 100644
--- a/retropikzel/named-pipes.scm
+++ b/retropikzel/named-pipes.scm
@@ -8,7 +8,7 @@
 
 ;(define-c-procedure c-system libc-stdlib 'system 'int '(pointer))
 (define-c-procedure c-mkfifo libc-stdlib 'mkfifo 'int '(pointer int))
-(define-c-procedure c-open libc-stdlib 'open 'int '(pointer int))
+(define-c-procedure c-open libc-stdlib 'open 'int '(pointer int int))
 (define-c-procedure c-read libc-stdlib 'read 'int '(int pointer int))
 (define-c-procedure c-write libc-stdlib 'write 'int '(int pointer int))
 (define-c-procedure c-close libc-stdlib 'close 'int '(int))
@@ -33,6 +33,8 @@
 (define O_WRONLY+O_CREAT 65)
 (define O_WRONLY+O_NONBLOCK+O_CREAT 2113)
 
+(define S_IRUSR-S_IWUSR 384)
+
 (define handle-c-errors
   (lambda (msg return-code)
     (when (and (number? return-code)
@@ -61,7 +63,8 @@
                                       (c-open (string->c-utf8 path)
                                               (if (null? block?)
                                                 O_RDONLY+O_NONBLOCK+O_CREAT
-                                                O_RDONLY+O_CREAT))))))
+                                                O_RDONLY+O_CREAT)
+                                              S_IRUSR-S_IWUSR)))))
 
 (define open-output-pipe
   (lambda (path . block?)
@@ -72,7 +75,8 @@
                                        (c-open (string->c-utf8 path)
                                                (if (null? block?)
                                                  O_WRONLY+O_NONBLOCK+O_CREAT
-                                                 O_WRONLY+O_CREAT))))))
+                                                 O_WRONLY+O_CREAT)
+                                               S_IRUSR-S_IWUSR)))))
 
 (define pipe-read-u8-buffer (make-c-bytevector (c-type-size 'u8)))
 (define pipe-read-u8
diff --git a/retropikzel/named-pipes/VERSION b/retropikzel/named-pipes/VERSION
index 3eefcb9..7dea76e 100644
--- a/retropikzel/named-pipes/VERSION
+++ b/retropikzel/named-pipes/VERSION
@@ -1 +1 @@
-1.0.0
+1.0.1