From 757bc3150f9c5c6e5927fe31b05b6d725a2a3f4d Mon Sep 17 00:00:00 2001 From: retropikzel Date: Sat, 6 Dec 2025 12:52:15 +0200 Subject: [PATCH] Fix ctrf library --- Dockerfile.jenkins | 8 +++++ Dockerfile.test | 46 ++++++++++++++++++++++++++ Jenkinsfile | 2 +- Makefile | 7 ++-- retropikzel/ctrf.scm | 65 ++++++++++++++++++------------------- retropikzel/ctrf.sld | 66 +------------------------------------- retropikzel/ctrf/README.md | 26 ++++++++++----- retropikzel/ctrf/test.scm | 6 ++++ 8 files changed, 116 insertions(+), 110 deletions(-) create mode 100644 Dockerfile.jenkins create mode 100644 Dockerfile.test diff --git a/Dockerfile.jenkins b/Dockerfile.jenkins new file mode 100644 index 0000000..1dbd00d --- /dev/null +++ b/Dockerfile.jenkins @@ -0,0 +1,8 @@ +FROM debian:trixie-slim +RUN apt-get update && apt-get install -y \ + make ca-certificates git docker.io gauche time mit-scheme +WORKDIR /cache +RUN git clone https://codeberg.org/retropikzel/compile-scheme.git --depth=1 +WORKDIR /cache/compile-scheme +RUN make build-gauche +RUN make install diff --git a/Dockerfile.test b/Dockerfile.test new file mode 100644 index 0000000..0cbb998 --- /dev/null +++ b/Dockerfile.test @@ -0,0 +1,46 @@ +ARG SCHEME=chibi +ARG IMAGE=${SCHEME}:head +FROM debian:trixie AS build +RUN apt-get update && apt-get install -y \ +git ca-certificates make gcc libffi-dev libffi-dev wget xz-utils libcurl4 +RUN mkdir ${HOME}/.snow && echo "()" > ${HOME}/.snow/config.scm +WORKDIR /build +RUN wget https://gitlab.com/-/project/6808260/uploads/094ce726ce3c6cf8c14560f1e31aaea0/akku-1.1.0.amd64-linux.tar.xz \ + && tar -xf akku-1.1.0.amd64-linux.tar.xz \ + && mv akku-1.1.0.amd64-linux akku +RUN git clone https://github.com/ashinn/chibi-scheme.git --depth=1 +RUN git clone https://codeberg.org/retropikzel/compile-scheme.git --depth=1 +WORKDIR /build/chibi-scheme +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 +FROM schemers/${IMAGE} +RUN apt-get update && apt-get install -y make gcc libffi-dev libcurl4 gauche +RUN mkdir ${HOME}/.snow && echo "()" > ${HOME}/.snow/config.scm +COPY --from=build /build /build +ARG SCHEME=chibi +WORKDIR /build/compile-scheme +RUN make install +WORKDIR /build/chibi-scheme +RUN make install +WORKDIR /build/chibi-scheme +RUN make install +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/ + diff --git a/Jenkinsfile b/Jenkinsfile index 8eb8cd1..b302b2f 100644 --- a/Jenkinsfile +++ b/Jenkinsfile @@ -2,7 +2,7 @@ pipeline { agent { dockerfile { label 'docker-x86_64' - filename 'Dockerfile.jenkins' + image 'Dockerfile.jenkins' args '--user=root --privileged -v /var/run/docker.sock:/var/run/docker.sock' reuseNode true } diff --git a/Makefile b/Makefile index 79a3a9f..8ffc9a4 100644 --- a/Makefile +++ b/Makefile @@ -1,6 +1,6 @@ TMPDIR=.tmp/${SCHEME} -.SILENT: build install test test-docker clean ${TMPDIR} +.SILENT: build install test-r7rs test-r7rs-docker clean ${TMPDIR} .PHONY: ${TMPDIR} SCHEME=chibi @@ -45,9 +45,10 @@ test-r7rs: ${TMPDIR} cd ${TMPDIR} && ./test-r7rs test-r7rs-docker: ${TMPDIR} - docker build --build-arg IMAGE=${DOCKERIMG} --build-arg SCHEME=${SCHEME} --tag=scheme-library-test-${SCHEME} -f Dockerfile.test . 2> ${TMPDIR}/docker.log || cat ${TMPDIR}/docker.log + echo "Building docker image..." + docker build --build-arg IMAGE=${DOCKERIMG} --build-arg SCHEME=${SCHEME} --tag=scheme-library-test-${SCHEME} -f Dockerfile.test --quiet . 2> ${TMPDIR}/docker.log || cat ${TMPDIR}/docker.log docker run -v "${PWD}:/workdir" -w /workdir -t scheme-library-test-${SCHEME} \ - sh -c "make SCHEME=${SCHEME} SNOW_CHIBI_ARGS=--always-yes build install test-r7rs; chmod -R 755 ${TMPDIR}" + sh -c "make SCHEME=${SCHEME} SNOW_CHIBI_ARGS=--always-yes LIBRARY=${LIBRARY} build install test-r7rs; chmod -R 755 ${TMPDIR}" clean: git clean -X -f diff --git a/retropikzel/ctrf.scm b/retropikzel/ctrf.scm index f87709d..9843120 100644 --- a/retropikzel/ctrf.scm +++ b/retropikzel/ctrf.scm @@ -4,23 +4,28 @@ (display any) (get-output-string (current-output-port)))) -(define runner +(define ctrf-runner (lambda () (let ((runner (test-runner-null)) - (tests (list)) + (tests (vector)) (current-test-start-time 0) - (current-test-groups '())) + (current-test-groups (vector))) (test-runner-on-group-begin! runner (lambda (runner suite-name count) - (set! current-test-groups (append current-test-groups (list suite-name))))) + (set! current-test-groups + (vector-append current-test-groups (vector suite-name))))) (test-runner-on-group-end! runner (lambda (runner) (set! current-test-groups - (reverse (list-tail (reverse current-test-groups) 1))))) + (list->vector + (reverse + (list-tail + (reverse (vector->list current-test-groups)) + 1)))))) (test-runner-on-test-begin! runner @@ -66,12 +71,13 @@ 'source-form (any->string (test-result-ref runner 'source-form)))) - (let ((test (alist->hash-table + (let ((test ;(alist->hash-table `((name . ,name) (status . ,status) (duration . ,duration) (suite . ,current-test-groups) - (extra . ,extra))))) + ;(extra . ,extra) + )));) (when (test-result-ref runner 'source-file) (hash-table-set! extra @@ -83,7 +89,7 @@ 'line (test-result-ref runner 'source-line))) - (set! tests (append tests (list test))))))) + (set! tests (vector-append tests (vector test))))))) (test-runner-on-final! runner @@ -94,32 +100,25 @@ (fail (test-runner-fail-count runner)) (xfail (test-runner-xfail-count runner)) (skipped (test-runner-skip-count runner)) - (tool (alist->hash-table - `((name . "srfi-64-retropikzel-ctrf")))) - (summary (alist->hash-table - `((tests . ,(+ pass xpass fail xfail)) - (passed . ,(+ pass xpass)) - (failed . ,(+ fail xfail)) - (pending . 0) - (skipped . ,skipped) - (other . 0)))) - (results (alist->hash-table - `((tool . ,tool) - (summary . ,summary) - (tests . ,tests)))) - (env (alist->hash-table - `((appName . ,implementation-name) - (osPlatform . ,operation-system)))) - (output (alist->hash-table - `((reportFormat . "CTRF") - (specVersion . "0.0.0") - (results . ,results) - (generatedBy . "(retropikzel ctrf)") - (environment . ,env))))) + (tool `((name . "srfi-64-retropikzel-ctrf"))) + (summary `((tests . ,(+ pass xpass fail xfail)) + (passed . ,(+ pass xpass)) + (failed . ,(+ fail xfail)) + (pending . 0) + (skipped . ,skipped) + (other . 0))) + (results `((tool . ,tool) + (summary . ,summary) + (tests . ,tests))) + (env `((appName . ,implementation-name) + (osPlatform . ,operation-system))) + (output `((reportFormat . "CTRF") + (specVersion . "0.0.0") + (results . ,results) + (generatedBy . "(retropikzel ctrf)") + (environment . ,env)))) - (display (json-write '((a . 1)))) + (json-write output (current-output-port)) (newline) (exit (+ fail xfail))))) runner))) - -(test-runner-factory runner) diff --git a/retropikzel/ctrf.sld b/retropikzel/ctrf.sld index de85e5e..32e91b8 100644 --- a/retropikzel/ctrf.sld +++ b/retropikzel/ctrf.sld @@ -7,71 +7,7 @@ (srfi 64) (srfi 69) (srfi 180)) - (export test-begin - test-end - test-group - test-group-with-cleanup - test-skip - test-expect-fail - test-match-name - test-match-nth - test-match-all - test-match-any - test-assert - test-eqv - test-eq - test-equal - test-approximate - test-error - test-read-eval-string - test-apply test-with-runner - test-exit - test-runner-null - test-runner? - test-runner-reset - test-result-alist - test-result-alist! - test-result-ref - test-result-set! - test-result-remove - test-result-clear - test-runner-pass-count - test-runner-fail-count - test-runner-xpass-count - test-runner-xfail-count - test-runner-skip-count - test-runner-test-name - test-runner-group-path - test-runner-group-stack - test-runner-aux-value - test-runner-aux-value! - test-result-kind test-passed? - test-runner-on-test-begin - test-runner-on-test-begin! - test-runner-on-test-end - test-runner-on-test-end! - test-runner-on-group-begin - test-runner-on-group-begin! - test-runner-on-group-end - test-runner-on-group-end! - test-runner-on-final - test-runner-on-final! - test-runner-on-bad-count - test-runner-on-bad-count! - test-runner-on-bad-end-name - test-runner-on-bad-end-name! - test-runner-factory - test-runner-create - test-runner-current - test-runner-get - test-runner-simple - test-on-group-begin-simple - test-on-group-end-simple - test-on-final-simple - test-on-test-begin-simple - test-on-test-end-simple - test-on-bad-count-simple - test-on-bad-end-name-simple) + (export ctrf-runner) (cond-expand ;; Guile has both r6rs and r7rs on (features) (guile diff --git a/retropikzel/ctrf/README.md b/retropikzel/ctrf/README.md index 2a6d6f4..452b785 100644 --- a/retropikzel/ctrf/README.md +++ b/retropikzel/ctrf/README.md @@ -1,10 +1,20 @@ -Uses SRFI-64 underneath, giving output as [Common Test Report Format](https://ctrf.io/). - -Features - -- Exports exactly same things as SRFI-64, it only alters the output -- Exists with exit code of count of failed tests -- Measures time spent running individual tests -- Adds implementation name and operation system onto the report +Test-runner for SRFI-64 that outputs +[Common Test Report Format](https://ctrf.io/). +Usage: + + + (import (scheme base) + (srfi 64) + (retropikzel ctrf)) + + (test-runner-current (ctrf-runner)) + + +Then run tests as usual. The CTRF output will be outputted into JSON file +named as $SCHEME-$TESTNAME.json. + +Any failing tests and summary will be printed into stdout. + +Exit code is the amount of failed tests. diff --git a/retropikzel/ctrf/test.scm b/retropikzel/ctrf/test.scm index 437b0f5..78a38c9 100644 --- a/retropikzel/ctrf/test.scm +++ b/retropikzel/ctrf/test.scm @@ -2,10 +2,16 @@ (scheme write) (scheme file) (scheme process-context) + (srfi 64) (retropikzel ctrf)) +(test-runner-current (ctrf-runner)) + (test-begin "ctrf") +(test-assert #t) +(test-assert #t) +(test-equal '1 '(1 2 3)) (test-assert #t) (test-end "ctrf")