Improve testing. Fix bug in named-pipes

.gitignore

@@ -22,3 +22,4 @@ test-r7rs
 example.scm
 example.sps
 example
+venv

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

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

retropikzel/named-pipes/VERSION

@@ -1 +1 @@
-1.0.0
+1.0.1