Retropikzel
/
foreign-c-libraries
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Improve testing. Fix bug in named-pipes

This commit is contained in:
retropikzel 2026-02-01 06:22:37 +02:00
parent 90add44e53
commit 7237a51643
4 changed files with 27 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitignore vendored
View File

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

18
Makefile
View File

@ -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

10
retropikzel/named-pipes.scm
View File

@ -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

2
retropikzel/named-pipes/VERSION
View File

@ -1 +1 @@
1.0.0
1.0.1