Fixing testing

2026-03-12 07:47:44 +02:00 · 2026-03-12 07:47:44 +02:00 · 1adaa618ca
parent 5ce7aaf7de
commit 1adaa618ca
6 changed files with 61 additions and 78 deletions
--- a/.gitignore
+++ b/.gitignore
@ -24,3 +24,4 @@ example.sps
 example
 venv
 foreign
+tmp
--- a/Dockerfile.test
+++ b/Dockerfile.test
@ -15,8 +15,6 @@ RUN make
 RUN make install
 WORKDIR /build/compile-scheme
 RUN make build-gauche
-WORKDIR /build
-RUN git clone https://codeberg.org/foreign-c/foreign-c.git --depth=2

 ARG SCHEME=chibi
 ARG IMAGE=${SCHEME}:head
@ -35,12 +33,9 @@ WORKDIR /build/akku
 RUN bash install.sh
 ENV PATH=/root/.local/bin:${PATH}
 RUN akku update
-WORKDIR /build/foreign-c
 RUN timeout 30 snow-chibi install --impls=${SCHEME} --always-yes "(srfi 64)" || true
 RUN timeout 30 snow-chibi install --impls=${SCHEME} --always-yes "(foreign c)" || true
-RUN make SCHEME=${SCHEME} build install
 WORKDIR /workdir
-RUN cp -r /build/foreign-c/foreign .
 COPY Makefile .
 COPY retropikzel retropikzel/

--- a/46
+++ b/46
@ -20,40 +20,28 @@ pipeline {

    stages {
        stage('Tests') {
-            parallel {
-                stage('R6RS') {
-                    steps {
-                        script {
-                            params.LIBRARIES.split().each { LIBRARY ->
-                            stage("${LIBRARY}") {
-                                    parallel params.R6RS_SCHEMES.split().collectEntries { SCHEME ->
-                                        [(SCHEME): {
-                                            def IMG="${SCHEME}:head"
-                                            catchError(buildResult: 'SUCCESS', stageResult: 'FAILURE') {
-                                                sh "timeout 600 make SCHEME=${SCHEME} LIBRARY=${LIBRARY} test-r6rs-docker"
-                                            }
-                                        }]
-                                    }
+            stage('R6RS') {
+                steps {
+                    script {
+                        params.LIBRARIES.split().each { LIBRARY ->
+                        stage("${LIBRARY}") {
+                            params.R6RS_SCHEMES.split().each { SCHEME ->
+                                catchError(buildResult: 'SUCCESS', stageResult: 'FAILURE') {
+                                    sh "timeout 600 make SCHEME=${SCHEME} LIBRARY=${LIBRARY} RNRS=r6rs run-test-docker"
                                }
                            }
                        }
                    }
                }
-                stage('R7RS') {
-                    steps {
-                        script {
-                            params.LIBRARIES.split().each { LIBRARY ->
-                                stage("${LIBRARY}") {
-                                    parallel params.R7RS_SCHEMES.split().collectEntries() { SCHEME ->
-                                        [(SCHEME): {
-                                            def IMG="${SCHEME}:head"
-                                            if("${SCHEME}" == "chicken") {
-                                                IMG="${SCHEME}:5"
-                                            }
-                                            catchError(buildResult: 'SUCCESS', stageResult: 'FAILURE') {
-                                                sh "timeout 600 make SCHEME=${SCHEME} LIBRARY=${LIBRARY} test-r7rs-docker"
-                                            }
-                                        }]
+            }
+            stage('R7RS') {
+                steps {
+                    script {
+                        params.LIBRARIES.split().each { LIBRARY ->
+                            stage("${LIBRARY}") {
+                                params.R7RS_SCHEMESsplit().each { SCHEME ->
+                                    catchError(buildResult: 'SUCCESS', stageResult: 'FAILURE') {
+                                        sh "timeout 600 make SCHEME=${SCHEME} LIBRARY=${LIBRARY} RNRS=r7rs run-test-docker"
                                    }
                                }
                            }
--- a/28
+++ b/28
@ -21,7 +21,6 @@ endif
 all: build

 build: retropikzel/${LIBRARY}/LICENSE retropikzel/${LIBRARY}/VERSION
-	rm -rf *.tgz
 	echo "<pre>$$(cat retropikzel/${LIBRARY}/README.md)</pre>" > ${README}
 	snow-chibi package --version=${VERSION} --authors=${AUTHOR} --doc=${README} --description="${DESCRIPTION}" ${LIBRARY_FILE}

@ -31,9 +30,9 @@ install:
 uninstall:
 	-snow-chibi remove --impls=${SCHEME} ${PKG}

-init-venv: build
+run-test-venv: build
 	rm -rf venv
-	scheme-venv ${SCHEME} ${RNRS} venv
+	scheme-venv ${SCHEME} venv
 	echo "(import (scheme base) (scheme write) (scheme read) (scheme char) (scheme file) (scheme process-context) (srfi 64) (retropikzel ${LIBRARY}))" > venv/test.scm
 	printf "#!r6rs\n(import (except (rnrs) remove) (srfi :64) (retropikzel ${LIBRARY}))" > venv/test.sps
 	cat ${TESTFILE} >> venv/test.scm
@ -48,12 +47,31 @@ init-venv: build
 	if [ "${SCHEME}" = "chicken" ]; then ./venv/bin/snow-chibi install --always-yes srfi.64; fi
 	if [ "${SCHEME}-${RNRS}" = "mosh-r7rs" ]; then ./venv/bin/snow-chibi install --always-yes srfi.64; fi
 	if [ "${RNRS}" = "r7rs" ]; then ./venv/bin/snow-chibi install ${PKG}; fi
-
-run-test: init-venv
 	if [ "${RNRS}" = "r6rs" ]; then ./venv/bin/scheme-compile venv/test.sps; fi
 	if [ "${RNRS}" = "r7rs" ]; then CSC_OPTIONS="-L -lcurl -L -lSDL2 -L -lSDL2_image" ./venv/bin/scheme-compile venv/test.scm; fi
 	./venv/test

+run-test-system: build
+	rm -rf tmp
+	mkdir -p tmp
+	printf "#!r6rs\n(import (except (rnrs) remove) (srfi :64) (retropikzel ${LIBRARY}))" > tmp/test.sps
+	cat ${TESTFILE} >> tmp/test.sps
+	echo "(import (scheme base) (scheme write) (scheme read) (scheme char) (scheme file) (scheme process-context) (srfi 64) (retropikzel ${LIBRARY}))" > tmp/test.scm
+	cat ${TESTFILE} >> tmp/test.scm
+	if [ "${RNRS}" = "r6rs" ]; then cp -r retropikzel tmp/lib/; fi
+	if [ "${RNRS}" = "r6rs" ]; then snow-chibi install --impls=generic --install-source-dir=tmp/lib --install-library-dir=tmp/lib --always-yes foreign.c; fi
+	if [ "${RNRS}" = "r6rs" ]; then cd tmp && akku install akku-r7rs chez-srfi; fi
+	if [ "${RNRS}" = "r7rs" ]; then snow-chibi install --impls=${SCHEME} --always-yes --skip-tests?=1 srfi.64; fi
+	if [ "${RNRS}" = "r7rs" ]; then snow-chibi install --impls=${SCHEME} --always-yes --skip-tests?=1 foreign.c; fi
+	if [ "${RNRS}" = "r7rs" ]; then snow-chibi install --impls=${SCHEME} --always-yes ${PKG}; fi
+	if [ "${RNRS}" = "r6rs" ]; then cd tmp && COMPILE_R7RS=${SCHEME} compile-scheme -o test test.sps; fi
+	if [ "${RNRS}" = "r7rs" ]; then cd tmp && CSC_OPTIONS="-L -lcurl -L -lSDL2 -L -lSDL2_image" COMPILE_R7RS=${SCHEME} compile-scheme -o test test.scm; fi
+	cd tmp && ./test
+
+run-test-docker:
+	docker build --build-arg IMAGE=${DOCKERIMG} --build-arg SCHEME=${SCHEME} --tag=foreign-c-library-test-${SCHEME} -f Dockerfile.test .
+	docker run -v "${PWD}/logs:/workdir/logs" -w /workdir -t foreign-c-library-test-${SCHEME} sh -c "make SCHEME=${SCHEME} LIBRARY=${LIBRARY} RNRS=${RNRS} run-test-system"
+
 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
--- a/retropikzel/requests/README.md
+++ b/retropikzel/requests/README.md
@ -1,7 +1,4 @@
-# requests
-
-Scheme library to make https requests. Built with
-[foreign c](https://sr.ht/~retropikzel/foreign-c/) and libcurl.
+Scheme library to make https requests. Built with (foreign c) and libcurl.

 [Repository](https://git.sr.ht/~retropikzel/foreign-c-requests)

@ -9,15 +6,11 @@ Scheme library to make https requests. Built with

 [Jenkins](https://jenkins.scheme.org/job/foreign_c/job/foreign-c-requests/)

-
-
 ## Caveats

 - Not yet working on Mosh
 - No cookie reading support yet

-
-
 ## Dependencies

 Depends on libcurl, on Debian/Ubuntu:
--- a/retropikzel/spite.scm
+++ b/retropikzel/spite.scm
@ -3,7 +3,7 @@
 (define exit? #f)
 (define scale-x 1.0)
 (define scale-y 1.0)
-(define events (list))
+(define events '())
 (define current-bitmap-font #f)
 (define current-line-size 1)
 (define draw-color-r 0)
@ -51,39 +51,29 @@
 (define event* (make-c-bytevector 4000))
 (define draw-rect* (make-c-bytevector (* (c-type-size 'int) 4)))
 (define draw-slice-rect* (make-c-bytevector (* (c-type-size 'int) 4)))
-(define fill-triangle-vertex-size 128) ;(+ (* (c-type-size 'int) 6) (* (c-type-size 'float) 2))
+(define fill-triangle-vertex-size (+ (* (c-type-size 'int) 6) (* (c-type-size 'float) 2)))
 (define fill-triangle-vertex1* (make-c-bytevector fill-triangle-vertex-size 0))
 (define fill-triangle-vertex2* (make-c-bytevector fill-triangle-vertex-size 0))
 (define fill-triangle-vertex3* (make-c-bytevector fill-triangle-vertex-size 0))
 (define fill-triangle-vertexes* (make-c-bytevector (* fill-triangle-vertex-size 3 0)))
-(c-bytevector-set! fill-triangle-vertexes*
-                   'pointer
-                   (* fill-triangle-vertex-size 0)
-                   fill-triangle-vertex1*)
-(c-bytevector-set! fill-triangle-vertexes*
-                   'pointer
-                   (* fill-triangle-vertex-size 1)
-                   fill-triangle-vertex2*)
-(c-bytevector-set! fill-triangle-vertexes*
-                   'pointer
-                   (* fill-triangle-vertex-size 2)
-                   fill-triangle-vertex3*)
-
-(define update-procedure #f)
-(define draw-procedure #f)
+(c-bytevector-set!
+  fill-triangle-vertexes* 'pointer (* fill-triangle-vertex-size 0) fill-triangle-vertex1*)
+(c-bytevector-set!
+  fill-triangle-vertexes* 'pointer (* fill-triangle-vertex-size 1) fill-triangle-vertex2*)
+(c-bytevector-set!
+  fill-triangle-vertexes* 'pointer (* fill-triangle-vertex-size 2) fill-triangle-vertex3*)

 (define main-loop-start-time 0)
 (define delta-time 0)
-(define main-loop
-  (lambda ()
-    (set! main-loop-start-time (current-jiffy))
-    (sdl2-events-get)
-    (update-procedure delta-time (poll-events!))
-    (render-clear)
-    (draw-procedure)
-    (render-present)
-    (set! delta-time (/ (- (current-jiffy) main-loop-start-time) (jiffies-per-second)))
-    (unless exit? (main-loop))))
+(define (main-loop update-procedure draw-procedure)
+  (set! main-loop-start-time (current-jiffy))
+  (sdl2-events-get)
+  (update-procedure delta-time (poll-events!))
+  (render-clear)
+  (draw-procedure)
+  (render-present)
+  (set! delta-time (/ (- (current-jiffy) main-loop-start-time) (jiffies-per-second)))
+  (unless exit? (main-loop update-procedure draw-procedure)))

 (define sdl2-event->spite-event
  (lambda (event)
@ -304,13 +294,11 @@
            (cons 'y (c-bytevector-ref y 'float 0))))))

 (define spite-start
-  (lambda (new-update-procedure new-draw-procedure)
-    (set! update-procedure new-update-procedure)
-    (set! draw-procedure new-draw-procedure)
+  (lambda (update-procedure draw-procedure)
    (cond
      ((not started?)
       (set! started? #t)
-       (main-loop)))))
+       (main-loop update-procedure draw-procedure)))))

 (define spite-init
  (lambda (title width height)