Fixed chicken test running

This commit is contained in:
retropikzel 2025-02-01 09:00:16 +02:00
parent 4a9a042906
commit 924e60dcb7
5 changed files with 24 additions and 14 deletions

1
.gitignore vendored
View File

@ -4,6 +4,7 @@ docuptmp
*.log
*.c
!libtest.c
*.a
*.so
*.o
*.so

View File

@ -1,10 +1,18 @@
.PHONY=libtest.so
CC=gcc
DOCKER=docker run -it -v ${PWD}:/workdir
DOCKER_INIT=apt-get update \
&& apt-get install -y git make \
&& git clone https://git.sr.ht/~retropikzel/compile-r7rs \
&& cd compile-r7rs && make install
libtest.so: libtest.c
${CC} -o libtest.so -shared -fPIC libtest.c
libtest.a: libtest.c
${CC} -fPIC -c libtest.c
ar rcs libtest.a libtest.o
CHIBI=chibi-scheme -A .
test-chibi-podman-amd64: libtest.so
podman run --arch=amd64 -it -v ${PWD}:/workdir docker.io/schemers/chibi bash -c "cd /workdir && chibi-ffi retropikzel/r7rs-pffi/r7rs-pffi-chibi.stub"
@ -24,21 +32,21 @@ retropikzel/r7rs-pffi/r7rs-pffi-chibi.so: retropikzel/r7rs-pffi/r7rs-pffi-chibi.
test-chibi: retropikzel/r7rs-pffi/r7rs-pffi-chibi.so libtest.so
${CHIBI} test.scm
CHICKEN5=SCMC=csc CSCFLAGS="-I. " compile-r7rs main.scm
CHICKEN5=SCMC=csc CSCFLAGS='-I. -L. -L -ltest' compile-r7rs -I . main.scm
#CHICKEN5=csc -X r7rs -R r7rs -uses scheme.base -I.
#CHICKEN5_LIB=csc -X r7rs -R r7rs -uses r7rs -I. -include-path ./retropikzel -s -J
#CHICKEN5_LIB=csc -X r7rs -R r7rs -uses r7rs -unit retropikzel.r7rs-pffi -include-path ./retropikzel -s -J
test-chicken5-podman-amd65: clean libtest.so
cp retropikzel/r7rs-pffi.sld retropikzel.r7rs-pffi.sld
podman run --arch=amd64 -it -v ${PWD}:/workdir docker.io/schemers/chicken:5 bash -c "cd /workdir && ${CHICKEN5_LIB} retropikzel.r7rs-pffi.sld"
test-chicken5-podman-amd65: clean libtest.a
#cp retropikzel/r7rs-pffi.sld retropikzel.r7rs-pffi.sld
#podman run --arch=amd64 -it -v ${PWD}:/workdir docker.io/schemers/chicken:5 bash -c "cd /workdir && ${CHICKEN5_LIB} retropikzel.r7rs-pffi.sld"
podman run --arch=amd64 -it -v ${PWD}:/workdir docker.io/schemers/chicken:5 bash -c "cd /workdir && ${CHICKEN5} test.scm && ./test"
test-chicken5-docker: clean libtest.so
cp retropikzel/r7rs-pffi.sld retropikzel.r7rs-pffi.sld
docker run -it -v ${PWD}:/workdir docker.io/schemers/chicken:5 bash -c "cd /workdir && ${CHICKEN5_LIB} retropikzel.r7rs-pffi.sld"
docker run -it -v ${PWD}:/workdir docker.io/schemers/chicken:5 bash -c "cd /workdir && ${CHICKEN5} test.scm && ./test"
test-chicken5-docker: clean libtest.a
#cp retropikzel/r7rs-pffi.sld retropikzel.r7rs-pffi.sld
#docker run -it -v ${PWD}:/workdir docker.io/schemers/chicken:5 bash -c "cd /workdir && ${CHICKEN5_LIB} retropikzel.r7rs-pffi.sld"
${DOCKER} schemers/chicken:5 bash -c "${DOCKER_INIT} && cd /workdir && ${CHICKEN5} test.scm && ./test"
test-chicken5: clean libtest.so
test-chicken5: clean libtest.a
#cp retropikzel/r7rs-pffi.sld retropikzel.r7rs-pffi.sld
#${CHICKEN5_LIB} retropikzel.r7rs-pffi.sld
${CHICKEN5} test.scm

View File

@ -128,6 +128,7 @@
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
;pffi-struct-dereference
pffi-define
;pffi-define-callback
))

View File

@ -20,6 +20,7 @@
((equal? type 'double) double)
((equal? type 'pointer) opaque)
((equal? type 'void) c-void)
((equal? type 'struct) 'c-pointer)
(else (error "pffi-type->native-type -- No such pffi type" type)))))
(define pffi-pointer?
@ -51,6 +52,7 @@
((equal? type 'double) 'double)
((equal? type 'pointer) 'c-pointer)
((equal? type 'void) 'void)
((equal? type 'struct) 'c-pointer)
(else (error "pffi-type->native-type -- No such pffi type" type)))))
(scheme-name (car (cdr expr)))
(c-name (symbol->string (car (cdr (car (cdr (cdr (cdr expr))))))))
@ -258,8 +260,7 @@
((equal? type 'unsigned-long) (pffi-pointer-unsigned-long-set! pointer offset value))
((equal? type 'float) (pffi-pointer-float-set! pointer offset value))
((equal? type 'double) (pffi-pointer-double-set! pointer offset value))
((equal? type 'pointer) (pffi-pointer-pointer-set! pointer offset value))
)))
((equal? type 'pointer) (pffi-pointer-pointer-set! pointer offset value)))))
(define-c pffi-pointer-int8-get
"(void *data, int argc, closure _, object k, object pointer, object offset)"
@ -373,5 +374,4 @@
((equal? type 'unsigned-long) (pffi-pointer-unsigned-long-get pointer offset))
((equal? type 'float) (pffi-pointer-float-get pointer offset))
((equal? type 'double) (pffi-pointer-double-get pointer offset))
((equal? type 'pointer) (pffi-pointer-pointer-get pointer offset))
)))
((equal? type 'pointer) (pffi-pointer-pointer-get pointer offset)))))

View File

@ -100,7 +100,7 @@
(define pffi-pointer->string
(lambda (pointer)
(pointer->string pointer)))
(pointer->string pointer)))
(define pffi-shared-object-load
(lambda (headers path)