Fix ctrf library

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

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/
+

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
         }

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

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
+             (tool `((name . "srfi-64-retropikzel-ctrf")))
-                     `((name . "srfi-64-retropikzel-ctrf"))))
+             (summary `((tests . ,(+ pass xpass fail xfail))
-             (summary (alist->hash-table
-                        `((tests . ,(+ pass xpass fail xfail))
                         (passed . ,(+ pass xpass))
                         (failed . ,(+ fail xfail))
                         (pending . 0)
                         (skipped . ,skipped)
-                          (other . 0))))
+                        (other . 0)))
-             (results (alist->hash-table
+             (results `((tool . ,tool)
-                        `((tool . ,tool)
                         (summary . ,summary)
-                          (tests . ,tests))))
+                        (tests . ,tests)))
-             (env (alist->hash-table
+             (env `((appName . ,implementation-name)
-                    `((appName . ,implementation-name)
+                    (osPlatform . ,operation-system)))
-                      (osPlatform . ,operation-system))))
+             (output `((reportFormat . "CTRF")
-             (output (alist->hash-table
-                       `((reportFormat . "CTRF")
                        (specVersion . "0.0.0")
                        (results . ,results)
                        (generatedBy . "(retropikzel ctrf)")
-                         (environment . ,env)))))
+                       (environment . ,env))))
 
-            (display (json-write '((a . 1))))
+            (json-write output (current-output-port))
             (newline)
             (exit (+ fail xfail)))))
       runner)))
-
-(test-runner-factory runner)

retropikzel/ctrf.sld

@@ -7,71 +7,7 @@
             (srfi 64)
             (srfi 69)
             (srfi 180))
-  (export test-begin
+  (export ctrf-runner)
-          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)
   (cond-expand
     ;; Guile has both r6rs and r7rs on (features)
     (guile

retropikzel/ctrf/README.md

@@ -1,10 +1,20 @@
-Uses SRFI-64 underneath, giving output as [Common Test Report Format](https://ctrf.io/).
+Test-runner for SRFI-64 that outputs
-
+[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
 
 
+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.

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")