Retropikzel
/
compile-r7rs
1
0
Fork 0
Code Issues 8 Pull Requests Releases Activity

Improcing test-r7rs

This commit is contained in:
retropikzel 2025-09-26 21:08:14 +03:00
parent 663ed649bd
commit 30e0813ef1
3 changed files with 123 additions and 129 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

67
Dockerfile
View File

@ -1,28 +1,55 @@
FROM schemers/chicken:5 AS build FROM debian:trixie-slim AS build
RUN apt-get update && apt-get install -y \ RUN apt-get update && apt-get install -y build-essential ca-certificates wget \
gcc wget ca-certificates xz-utils make git libffi-dev unzip lbzip2 cmake \ git autoconf automake libtool texinfo
g++ python3 locate zlib1g-dev
RUN git clone https://github.com/ashinn/chibi-scheme.git --depth=1
WORKDIR /chibi-scheme
RUN make
RUN make install
WORKDIR /build WORKDIR /build
RUN git clone https://github.com/ashinn/chibi-scheme.git --depth=1 chibi
ENV SCHEME=chicken WORKDIR /build/chibi
RUN make DESTDIR=/opt/compile-r7rs
RUN make DESTDIR=/opt/compile-r7rs install
WORKDIR /build
RUN echo "#!/bin/sh" > /opt/compile-r7rs/snow-chibi
RUN echo "PATH=/opt/compile-r7rs/usr/local/bin:${PATH} LD_LIBRARY_PATH=/opt/compile-r7rs/usr/local/lib:/opt/compile-r7rs/usr/local/lib/chibi CHIBI_MODULE_PATH=/opt/compile-r7rs/usr/local/share/chibi:/opt/compile-r7rs/usr/local/lib/chibi /opt/compile-r7rs/usr/local/bin/chibi-scheme -I /opt/compile-r7rs/usr/local/share/chibi -I /opt/compile-r7rs/usr/local/lib/chibi -I /opt/compile/snow -mchibi.snow.commands -mchibi.snow.interface -mchibi.snow.package -mchibi.snow.utils /opt/compile-r7rs/usr/local/bin/snow-chibi.scm \"\$@\"" >> /opt/compile-r7rs/snow-chibi
RUN chmod +x /opt/compile-r7rs/snow-chibi
ENV PATH=/opt/compile-r7rs:${PATH}
RUN git clone https://github.com/libffi/libffi.git --branch=v3.5.2 --depth=1
WORKDIR /build/libffi
RUN sh autogen.sh
RUN ./configure --prefix=/usr/local
RUN make DESTDIR=/opt/compile-r7rs PREFIX=/usr/local
RUN make DESTDIR=/opt/compile-r7rs PREFIX=/usr/local install
WORKDIR /build
RUN mkdir -p ${HOME}/.snow && echo "()" > ${HOME}/.snow/config.scm RUN mkdir -p ${HOME}/.snow && echo "()" > ${HOME}/.snow/config.scm
RUN snow-chibi --impls=${SCHEME} --always-yes install "(foreign c)" RUN snow-chibi install \
RUN snow-chibi --impls=${SCHEME} --always-yes install "(retropikzel system)" --cflags="-I/opt/compile-r7rs/usr/local/include -L/opt/compile-r7rs/usr/local/lib" \
RUN snow-chibi --impls=${SCHEME} --always-yes install "(srfi 170)" --install-source-dir=/opt/compile-r7rs/usr/local/share/chibi \
--install-library-dir=/opt/compile-r7rs/usr/local/lib/chibi \
"(foreign c)"
RUN snow-chibi install --install-source-dir=/opt/compile-r7rs/usr/local/share/chibi --install-library-dir=/opt/compile-r7rs/usr/local/lib/chibi "(retropikzel system)"
RUN snow-chibi install --install-source-dir=/opt/compile-r7rs/usr/local/share/chibi --install-library-dir=/opt/compile-r7rs/usr/local/lib/chibi "(srfi 170)"
COPY Makefile . COPY compile-r7rs.scm /opt/compile-r7rs/
COPY compile-r7rs.scm . COPY test-r7rs.scm /opt/compile-r7rs/
COPY test-r7rs.scm . RUN mkdir -p /opt/compile-r7rs/usr/local/share/chibi/libs
COPY libs libs COPY libs/*.sld /opt/compile-r7rs/usr/local/share/chibi/libs/
COPY libs/*.scm /opt/compile-r7rs/usr/local/share/chibi/libs/
RUN make PREFIX=/opt/compile-r7rs RUN echo "#!/bin/sh" > /opt/compile-r7rs/compile-r7rs
RUN make PREFIX=/opt/compile-r7rs install RUN echo "LD_LIBRARY_PATH=/opt/compile-r7rs/usr/local/lib:/opt/compile-r7rs/usr/local/lib/chibi CHIBI_MODULE_PATH=/opt/compile-r7rs/usr/local/share/chibi:/opt/compile-r7rs/usr/local/lib/chibi /opt/compile-r7rs/usr/local/bin/chibi-scheme -mchibi.snow.commands -mchibi.snow.interface -mchibi.snow.package -mchibi.snow.utils /opt/compile-r7rs/compile-r7rs.scm \"\$@\"" >> /opt/compile-r7rs/compile-r7rs
RUN chmod +x /opt/compile-r7rs/compile-r7rs
FROM debian:trixie RUN echo "#!/bin/sh" > /opt/compile-r7rs/test-r7rs
RUN echo "LD_LIBRARY_PATH=/opt/compile-r7rs/usr/local/lib:/opt/compile-r7rs/usr/local/lib/chibi CHIBI_MODULE_PATH=/opt/compile-r7rs/usr/local/share/chibi:/opt/compile-r7rs/usr/local/lib/chibi /opt/compile-r7rs/usr/local/bin/chibi-scheme -mchibi.snow.commands -mchibi.snow.interface -mchibi.snow.package -mchibi.snow.utils /opt/compile-r7rs/test-r7rs.scm \"\$@\"" >> /opt/compile-r7rs/test-r7rs
RUN chmod +x /opt/compile-r7rs/test-r7rs
FROM debian:trixie-slim
RUN apt-get update && apt-get install -y libffi-dev docker.io locate
COPY --from=build /opt/compile-r7rs /opt/compile-r7rs COPY --from=build /opt/compile-r7rs /opt/compile-r7rs
ENV PATH=/opt/compile-r7rs/bin:${PATH} RUN updatedb
RUN locate foreign-c.so
ENV PATH=/opt/compile-r7rs:${PATH}

1
Makefile
View File

@ -39,7 +39,6 @@ docker-image-alpine:
docker-image-alpine-push: docker-image-alpine-push:
docker push retropikzel1/compile-r7rs:alpine-latest docker push retropikzel1/compile-r7rs:alpine-latest
libs.util.a: libs/util.sld libs/util.scm libs.util.a: libs/util.sld libs/util.scm
csc -R r7rs -X r7rs -static -c -J -unit libs.util -o libs.util.o libs/util.sld csc -R r7rs -X r7rs -static -c -J -unit libs.util -o libs.util.o libs/util.sld
ar rcs libs.util.a libs.util.o ar rcs libs.util.a libs.util.o

184
test-r7rs.scm
View File

@ -11,10 +11,61 @@
(srfi 170) (srfi 170)
(retropikzel system)) (retropikzel system))
(for-each
(lambda (path) (when (not (file-exists? path)) (create-directory path)))
`(".test-r7rs" ".test-r7rs/tmp"))
(define lines ":----------------")
(define cell-width 17)
(define (make-cell text)
(letrec* ((looper (lambda (result)
(if (> (string-length result) cell-width)
result
(looper (string-append result " "))))))
(string-append "| " (looper text))))
(define (make-row items)
(string-append (apply string-append (map make-cell items)) "|"))
(define (print-header output-file timestamp timeout)
(for-each
echo
`(,(string-append "# Test report - " output-file)
""
,(string-append "Timestamp(UTC): " timestamp)
""
"Output files are under .test-r7rs/output"
"Log files are under .test-r7rs/logs"
"Any other output is under .test-r7rs/tmp for debugging"
,(string-append "Timeout: " timeout)
""
;"Exit code 124 means timed out."
""
"First run may take a while as docker containers are being built"
""
,(make-row '("Implementation"
"Passes"
"Unexpected passes"
"Failures"
"Expected failures"
"Skipped tests"
"Build exit code"
"Run exit code"))
,(make-row (list lines lines lines lines lines lines lines lines)))))
(define timeout (define timeout
(if (get-environment-variable "TEST_R7RS_TIMEOUT") (if (member "--timeout" (command-line))
(get-environment-variable "TEST_R7RS_TIMEOUT") (cadr (member "--timeout" (command-line)))
"6000")) "6000"))
(define timestamp-path ".test-r7rs/timestamp")
(system (string-append "date --iso-8601=minutes --utc > " timestamp-path))
(define timestamp
(if (file-exists? timestamp-path)
(with-input-from-file timestamp-path (lambda () (read-line)))
""))
(define input-file (define input-file
(let ((input-file #f)) (let ((input-file #f))
@ -31,6 +82,14 @@
(cadr (member "-o" (command-line))) (cadr (member "-o" (command-line)))
"a.out")) "a.out"))
(define print-header?
(if (member "--no-header" (command-line)) #f #t))
(when print-header?
(print-header output-file timestamp timeout))
(when (member "--only-header" (command-line)) (exit 0))
(define stop-on-error? (define stop-on-error?
(if (member "--stop-on-error" (command-line)) #t #f)) (if (member "--stop-on-error" (command-line)) #t #f))
@ -50,12 +109,8 @@
#f) #f)
((not (string? compile-r7rs)) ((not (string? compile-r7rs))
(error "COMPILE_R7RS is not a string" compile-r7rs)) (error "COMPILE_R7RS is not a string" compile-r7rs))
((string=? compile-r7rs "all-r6rs")
(map symbol->string r6rs-schemes))
((string=? compile-r7rs "all-r7rs")
(map symbol->string r7rs-schemes))
(else (else
(list compile-r7rs))))) (string-split compile-r7rs #\space)))))
(when (not schemes) (error "Environment variable COMPILE_R7RS not set.")) (when (not schemes) (error "Environment variable COMPILE_R7RS not set."))
(when (and (< (length schemes) 2) (when (and (< (length schemes) 2)
(not (assoc (string->symbol (car schemes)) data))) (not (assoc (string->symbol (car schemes)) data)))
@ -109,16 +164,6 @@
(get-output-string pkgs))) (get-output-string pkgs)))
(define apt-pkgs (util-getenv "APT_PKGS")) (define apt-pkgs (util-getenv "APT_PKGS"))
(define lines ":----------------")
(define cell-width 17)
(define (make-cell text)
(letrec* ((looper (lambda (result)
(if (> (string-length result) cell-width)
result
(looper (string-append result " "))))))
(string-append "| " (looper text))))
(define (make-row items)
(string-append (apply string-append (map make-cell items)) "|"))
(define (string-copy-until text begin-index until-char) (define (string-copy-until text begin-index until-char)
(letrec* ((end (string->list (string-copy text begin-index))) (letrec* ((end (string->list (string-copy text begin-index)))
(looper (lambda (c rest result) (looper (lambda (c rest result)
@ -141,10 +186,12 @@
(string-copy-until line prefix-length #\() (string-copy-until line prefix-length #\()
(when (not (eof-object? line)) (when (not (eof-object? line))
(looper (read-line))))))) (looper (read-line)))))))
(with-input-from-file (if (file-exists? run-out)
run-out (with-input-from-file
(lambda () run-out
(trim-both (looper (read-line))))))) (lambda ()
(trim-both (looper (read-line)))))
"")))
(define (write-dockerfile scheme snow-pkgs akku-pkgs apt-pkgs) (define (write-dockerfile scheme snow-pkgs akku-pkgs apt-pkgs)
(let ((dockerfile-path (string-append ".test-r7rs/" scheme "/Dockerfile"))) (let ((dockerfile-path (string-append ".test-r7rs/" scheme "/Dockerfile")))
@ -154,104 +201,24 @@
(lambda () (lambda ()
(for-each (for-each
echo echo
`("FROM debian:trixie AS build" `(,(string-append "FROM schemers/"
"RUN apt-get update && apt-get install -y git gcc wget make guile-3.0-dev libcurl4-openssl-dev chicken-bin"
"RUN chicken-install r7rs"
"WORKDIR /cache"
"RUN git clone https://github.com/ashinn/chibi-scheme.git --depth=1"
"WORKDIR /cache/chibi-scheme"
"RUN make"
"RUN make install"
"WORKDIR /cache"
"RUN wget https://gitlab.com/-/project/6808260/uploads/819fd1f988c6af5e7df0dfa70aa3d3fe/akku-1.1.0.tar.gz && tar -xf akku-1.1.0.tar.gz"
"RUN mv akku-1.1.0 akku"
"WORKDIR /cache/akku"
"RUN ./configure && make"
"WORKDIR /cache"
"RUN snow-chibi install --always-yes --impls=chicken \"(foreign c)\""
"RUN snow-chibi install --always-yes --impls=chicken \"(retropikzel system)\""
"RUN snow-chibi install --always-yes --impls=chicken \"(srfi 170)\""
"RUN git clone https://gitea.scheme.org/Retropikzel/compile-r7rs.git --depth=1"
"WORKDIR /cache/compile-r7rs"
"RUN make"
,(string-append "FROM schemers/"
scheme scheme
(cond ((and (string=? scheme "chicken") (cond ((and (string=? scheme "chicken")
use-docker-head?) use-docker-head?)
":5") ":5")
(use-docker-head? ":head") (use-docker-head? ":head")
(else ""))) (else "")))
,(string-append "RUN mkdir -p ${HOME}/.snow && echo '()' > ${HOME}/.snow/config.scm"
"RUN apt-get update && apt-get install -y make guile-3.0 libcurl4-openssl-dev time tree file " apt-pkgs)
"RUN mkdir -p ${HOME}/.snow && echo \"()\" > ${HOME}/.snow/config.scm"
"COPY --from=build /cache /cache"
"COPY --from=retropikzel1/compile-r7rs /opt/compile-r7rs /opt/compile-r7rs" "COPY --from=retropikzel1/compile-r7rs /opt/compile-r7rs /opt/compile-r7rs"
"ENV PATH=/opt/compile-r7rs:${PATH}"
"ENV PATH=/opt/compile-r7rs/bin:${PATH}" ,(string-append "RUN /opt/compile-r7rs/snow-chibi install --always-yes --impls=" scheme " " snow-pkgs)
,(string-append "ENV COMPILE_R7RS=" scheme) ,(string-append "ENV COMPILE_R7RS=" scheme)
"WORKDIR /cache/chibi-scheme"
"RUN make install"
"WORKDIR /cache/akku"
"RUN make install"
"WORKDIR /cache/compile-r7rs"
"RUN make install"
"WORKDIR /akku"
"RUN akku update"
,(string-append "RUN snow-chibi install --always-yes --impls=" scheme " " snow-pkgs)
,(string-append "RUN akku install " akku-pkgs)
"WORKDIR /workdir")))) "WORKDIR /workdir"))))
dockerfile-path)) dockerfile-path))
(define (docker-run-cmd tag cmd) (define (docker-run-cmd tag cmd)
(string-append "docker run -i -v \"${PWD}:/workdir\" --workdir /workdir " (string-append "docker run -i -v \"${PWD}:/workdir\" --workdir /workdir "
tag " sh -c \"time timeout " timeout " " cmd "\"")) tag " sh -c \"timeout " timeout " " cmd "\""))
(for-each
(lambda (path) (when (not (file-exists? path)) (create-directory path)))
`(".test-r7rs" ".test-r7rs/tmp"))
(define timestamp-path ".test-r7rs/timestamp")
(system (string-append "date --iso-8601=minutes --utc > " timestamp-path))
(define timestamp
(if (file-exists? timestamp-path)
(with-input-from-file timestamp-path (lambda () (read-line)))
""))
(for-each
echo
`(,(string-append "# Test report - " output-file)
""
,(string-append "Timestamp(UTC): " timestamp)
""
"Output files are under .test-r7rs/output"
"Log files are under .test-r7rs/logs"
"Any other output is under .test-r7rs/tmp for debugging"
,(string-append "Timeout: " timeout)
""
;"Exit code 124 means timed out."
""
"First run may take a while as docker containers are being built"
""
,(make-row '("Implementation"
"Passes"
"Unexpected passes"
"Failures"
"Expected failures"
"Skipped tests"
"Build exit code"
"Run exit code"))
,(make-row (list lines lines lines lines lines lines lines lines))))
(for-each (for-each
(lambda (scheme) (lambda (scheme)
@ -311,7 +278,7 @@
(logfile (string-append testname ".log")) (logfile (string-append testname ".log"))
(scheme-docker-build-out (string-append scheme-log-dir "/" output-file "-docker.log")) (scheme-docker-build-out (string-append scheme-log-dir "/" output-file "-docker.log"))
(scheme-build-out (string-append scheme-log-dir "/" output-file "-build.log")) (scheme-build-out (string-append scheme-log-dir "/" output-file "-build.log"))
(scheme-run-out (string-append scheme-log-dir "/" output-file "-run.log")) (scheme-run-out(string-append scheme-log-dir "/" output-file "-run.log"))
(scheme-results-out (string-append scheme-log-dir "/" output-file "-results.log")) (scheme-results-out (string-append scheme-log-dir "/" output-file "-results.log"))
(short-test-results (srfi-64-output-read (if (file-exists? run-out) (slurp run-out) ""))) (short-test-results (srfi-64-output-read (if (file-exists? run-out) (slurp run-out) "")))
(passes (cdr (assoc 'expected-passes short-test-results))) (passes (cdr (assoc 'expected-passes short-test-results)))
@ -347,6 +314,7 @@
(newline) (newline)
(cat scheme-run-out) (cat scheme-run-out)
(exit 1))) (exit 1)))
(when stop-on-fail? (when stop-on-fail?
(when (and (string->number failures) (> (string->number failures) 0)) (when (and (string->number failures) (> (string->number failures) 0))
(let ((pretty-print (lambda (pair) (let ((pretty-print (lambda (pair)