Improvements to named-pipes and shell libraries
This commit is contained in:
parent
0d9e40ad4d
commit
5594b37d4e
20
Makefile
20
Makefile
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
1.0.2
|
||||
1.0.3
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -4,6 +4,7 @@
|
|||
(scheme write)
|
||||
(scheme read)
|
||||
(scheme file)
|
||||
(srfi 170)
|
||||
(foreign c)
|
||||
(retropikzel system)
|
||||
(retropikzel named-pipes))
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
1.0.1
|
||||
1.0.2
|
||||
|
|
|
|||
Loading…
Reference in New Issue