Improvements to named-pipes and shell libraries

This commit is contained in:
retropikzel 2026-05-13 22:51:50 +03:00
parent 0d9e40ad4d
commit 5594b37d4e
6 changed files with 21 additions and 35 deletions

View File

@ -1,6 +1,5 @@
SCHEME=chibi
DOCKER_TAG=latest
IMAGE=${SCHEME}:${DOCKER_TAG}
DOCKER_TAG=head
RNRS=r7rs
LIBRARY=system
AUTHOR=Retropikzel
@ -43,7 +42,7 @@ testfiles: package
rm -rf .tmp
mkdir -p .tmp
cp -r test-resources .tmp/
cp -r retropikzel .tmp/
if [ "${RNRS}" = "${R6RS}" ]; then cp -r retropikzel .tmp/; fi
# R6RS testfiles
printf "#!r6rs\n(import (except (rnrs) remove) (srfi :64) (foreign c) (retropikzel ${LIBRARY}))" > .tmp/test.sps
cat ${TESTFILE} >> .tmp/test.sps
@ -53,28 +52,23 @@ testfiles: package
cp -r ../foreign-c/foreign .tmp/
cp -r ../generated-foreign-c-libraries/c2foreign-c .tmp/
cp ${PKG} .tmp/
cd .tmp && if [ "${RNRS}" = "r6rs" ]; then snow-chibi --impls=generic install --always-yes --install-source-dir=. --install-library-dir=. ${PKG}; fi
cd .tmp && if [ "${RNRS}" = "r6rs" ]; then akku install akku-r7rs; fi
test: testfiles
cd .tmp && \
COMPILE_R7RS=${SCHEME} \
CSC_OPTIONS="${CSC_OPTIONS}" \
compile-r7rs ${LIB_PATHS} \
-o test-program \
test.${SFX}
compile-r7rs ${LIB_PATHS} -o test-program test.${SFX}
cd .tmp && ./test-program
test-docker: testfiles
cd .tmp && \
TEST_R7RS_DEBUG=1 \
DOCKER_TAG=${DOCKER_TAG} \
COMPILE_R7RS=${SCHEME} \
CSC_OPTIONS="${CSC_OPTIONS}" \
SNOW_PACKAGES="srfi.64 foreign.c" \
SNOW_PACKAGES="srfi.64 srfi.170 foreign.c retropikzel.system retropikzel.named-pipes ${PKG}" \
APT_PACKAGES="${APT_PACKAGES}" \
test-r7rs \
-o test-program \
test.${SFX} \
${PKG}
test-r7rs -o test-program test.${SFX}
clean:
git clean -X -f

View File

@ -36,9 +36,6 @@
(lambda (msg return-code)
(when (and (number? return-code)
(< return-code 0))
(display "HERE: ")
(write return-code)
(newline)
(c-perror (string->c-bytevector msg))
(error msg return-code))
return-code))

View File

@ -1 +1 @@
1.0.2
1.0.3

View File

@ -1,24 +1,18 @@
(define-c-library libc '("stdlib.h" "stdio.h" "unistd.h") #f '())
(define-c-procedure c-tempnam libc 'tempnam 'pointer '(pointer pointer))
(define previous-exit-code #f)
(define (shell cmd)
(when (not (string? cmd)) (error "shell: cmd must be string" cmd))
(let* ((temp-prefix (string->c-bytevector "npcmd"))
(temp-name (lambda ()
(c-bytevector->string (c-tempnam (c-bytevector-null)
temp-prefix))))
(input-path (temp-name))
(shell-command (string-append cmd
" 1> "
input-path
" 2> "
input-path
" & ")))
(create-pipe input-path 0777)
(set! previous-exit-code (system shell-command))
(pipe-read-string 64000 (open-input-pipe input-path #t))))
(call-with-temporary-filename
(lambda (input-path)
(let* ((shell-command (string-append cmd
" 1> "
input-path
" 2> "
input-path
" & ")))
(create-pipe input-path 0777)
(set! previous-exit-code (system shell-command))
(pipe-read-string 64000 (open-input-pipe input-path #t))))))
(define (lines->list port result)
(let ((line (read-line port)))

View File

@ -4,6 +4,7 @@
(scheme write)
(scheme read)
(scheme file)
(srfi 170)
(foreign c)
(retropikzel system)
(retropikzel named-pipes))

View File

@ -1 +1 @@
1.0.1
1.0.2