From 2d27e6687db6917d04ad815adc86bb70493fc4a4 Mon Sep 17 00:00:00 2001 From: retropikzel Date: Fri, 24 Jul 2026 09:06:30 +0300 Subject: [PATCH] scsh: Add tests. Simpilify makefile --- .gitignore | 1 + Makefile | 52 +++++++++++--------------------------- retropikzel/scsh.scm | 8 ------ retropikzel/scsh.sld | 9 ++++--- retropikzel/scsh.unix.scm | 28 ++++++++++++++++++++ retropikzel/scsh/README.md | 15 ++++++++++- retropikzel/scsh/test.scm | 32 +++++++++++++++++++++++ 7 files changed, 96 insertions(+), 49 deletions(-) delete mode 100644 retropikzel/scsh.scm create mode 100644 retropikzel/scsh.unix.scm create mode 100644 retropikzel/scsh/test.scm diff --git a/.gitignore b/.gitignore index f2019a1..78f7b0f 100644 --- a/.gitignore +++ b/.gitignore @@ -26,3 +26,4 @@ venv foreign tmp *.json +test-program diff --git a/Makefile b/Makefile index 41a833e..12a8eb4 100644 --- a/Makefile +++ b/Makefile @@ -4,14 +4,7 @@ DOCKER_TAG=latest RNRS=r7rs LIBRARY=system AUTHOR=Retropikzel -tmpdir=.tmp/${SCHEME}/${LIBRARY} -SFX=scm -LIB_PATHS= -ifeq "${RNRS}" "r6rs" -SFX=sps -LIB_PATHS=-I .akku/lib -endif VERSION != cat retropikzel/${LIBRARY}/VERSION PACKAGE_ARGS != cat retropikzel/${LIBRARY}/PACKAGE_ARGS 2> /dev/null || echo "" CSC_OPTIONS != cat retropikzel/${LIBRARY}/CSC_OPTIONS 2> /dev/null || echo "" @@ -55,37 +48,22 @@ ${PKG}: package install: snow-chibi install --impls=${SCHEME} --always-yes ${PKG} -testfiles: ${PKG} - rm -rf ${tmpdir} - mkdir -p ${tmpdir} - cp -r test-resources ${tmpdir} - # R6RS testfiles - printf "#!r6rs\n(import (except (rnrs) remove) (srfi :64) (foreign c) (retropikzel ${LIBRARY}))" > ${tmpdir}/test.sps - cat ${TESTFILE} >> ${tmpdir}/test.sps - # R7RS testfiles - echo "(import (scheme base) (scheme write) (scheme read) (scheme char) (scheme file) (scheme process-context) (srfi 64) (foreign c) (retropikzel ${LIBRARY}))" > ${tmpdir}/test.scm - cat ${TESTFILE} >> ${tmpdir}/test.scm - cp ${PKG} ${tmpdir} +test: + rm -rf test-program + COMPILE_R7RS=${SCHEME} \ + CSC_OPTIONS="${CSC_OPTIONS}" \ + compile-r7rs -o test-program ${TESTFILE} + ./test-program -test: testfiles - cd ${tmpdir} && \ - COMPILE_R7RS_DEBUG=1 \ - COMPILE_R7RS=${SCHEME} \ - CSC_OPTIONS="${CSC_OPTIONS}" \ - compile-r7rs ${LIB_PATHS} -o test-program test.${SFX} - cd ${tmpdir} && ./test-program - -test-docker: testfiles - cd ${tmpdir} && \ - TEST_R7RS_DEBUG=1 \ - DOCKER_TAG=${DOCKER_TAG} \ - COMPILE_R7RS=${SCHEME} \ - CSC_OPTIONS="${CSC_OPTIONS}" \ - SNOW_PACKAGES="srfi.64 foreign.c ${PKG}" \ - AKKU_PACKAGES="akku-r7rs chez-srfi '(foreign c)' '(retropikzel ${LIBRARY})'" \ - APT_PACKAGES="${APT_PACKAGES}" \ - PASS_ENV_VARS="CSC_OPTIONS" \ - test-r7rs ${LIB_PATHS} -o test-program test.${SFX} +test-docker: + DOCKER_TAG=${DOCKER_TAG} \ + COMPILE_R7RS=${SCHEME} \ + CSC_OPTIONS="${CSC_OPTIONS}" \ + SNOW_PACKAGES="srfi.64 foreign.c ${PKG}" \ + AKKU_PACKAGES="akku-r7rs chez-srfi '(foreign c)' '(retropikzel ${LIBRARY})'" \ + APT_PACKAGES="${APT_PACKAGES}" \ + PASS_ENV_VARS="CSC_OPTIONS" \ + test-r7rs -o test-program ${TESTFILE} clean: git clean -X -f diff --git a/retropikzel/scsh.scm b/retropikzel/scsh.scm deleted file mode 100644 index d98d249..0000000 --- a/retropikzel/scsh.scm +++ /dev/null @@ -1,8 +0,0 @@ -(define-c-library libc '("stdlib.h" "string.h" "stdio.h") #f ()) - -;(define-c-procedure c-setenv libc 'setenv 'int '(pointer pointer int)) - -(define (setenv var val) - (when (not (string? var)) (error "setenv error: var must be string")) - (when (not (string? val)) (error "setenv error: val must be string")) - (set-environment-variable! var val)) diff --git a/retropikzel/scsh.sld b/retropikzel/scsh.sld index 0fc20b6..7a60d32 100644 --- a/retropikzel/scsh.sld +++ b/retropikzel/scsh.sld @@ -3,6 +3,7 @@ (import (scheme base) (scheme write) (scheme file) + (scheme process-context) (foreign c) (srfi 170)) (export @@ -205,8 +206,8 @@ ;fork/pipe+ ;format-date ;get-lock-region - ;getenv - ;glob + getenv + glob ;glob-quote group-info group-info:gid @@ -745,4 +746,6 @@ ;write-string ;write-string/partial ) - (include "scsh.scm")) + (cond-expand + (windows (begin (error "Windows not supported"))) + (else (include "scsh.unix.scm")))) diff --git a/retropikzel/scsh.unix.scm b/retropikzel/scsh.unix.scm new file mode 100644 index 0000000..2124ed7 --- /dev/null +++ b/retropikzel/scsh.unix.scm @@ -0,0 +1,28 @@ +(define-c-library libc '("stdlib.h" "string.h" "stdio.h" "glob.h") #f ()) + +;(define-c-procedure c-setenv libc 'setenv 'int '(pointer pointer int)) + +(define (setenv var val) + (when (not (string? var)) (error "setenv error: var must be string")) + (when (not (string? val)) (error "setenv error: val must be string")) + (set-environment-variable! var val)) + +(define getenv get-environment-variable) + +(define-c-procedure c-glob libc 'glob 'int '(pointer int pointer pointer)) +(define-c-procedure c-globfree libc 'globfree 'int '(pointer)) +(define-c-struct-type glob-struct '((gl_pathc int) (gl_pathv pointer) (gl_offs int))) +(define glob + (lambda paths + (let ((result '())) + (for-each + (lambda (path) + (let ((glob-struct-cbv (make-c-bytevector (c-type-size glob-struct))) + (path-cbv (string->c-bytevector path))) + (c-glob path-cbv 0 glob-struct-cbv) + (display "HERE: path ") + (display path) + (newline) + (c-bytevector-free path-cbv) + )) + paths)))) diff --git a/retropikzel/scsh/README.md b/retropikzel/scsh/README.md index 00d7bdd..8effb70 100644 --- a/retropikzel/scsh/README.md +++ b/retropikzel/scsh/README.md @@ -1 +1,14 @@ -WIP +Scsh - The Scheme Shell + +This is an implementation of [scsh](https://scsh.net/) on top of +[(foreign c)](https://codeberg.org/foreign-c/foreign-c). + + +Not everything is implemented yet, see scsh.sld for commented out exports. + +Currently only supports Linux. + + +## Documentation + +See [https://scsh.net/docu/html/man-Z-H-13.html#node_index_start](https://scsh.net/docu/html/man-Z-H-13.html#node_index_start) diff --git a/retropikzel/scsh/test.scm b/retropikzel/scsh/test.scm new file mode 100644 index 0000000..c893e7c --- /dev/null +++ b/retropikzel/scsh/test.scm @@ -0,0 +1,32 @@ +(import (scheme base) + (scheme write) + (scheme read) + (scheme char) + (scheme file) + (scheme process-context) + (retropikzel scsh) + (srfi 64) + (retropikzel tap)) + +(test-runner-current (tap-runner)) + +(test-begin "scsh") + +(test-begin "setenv") +(setenv "SCSH_TEST1" "foobar") +(test-equal "foobar" (get-environment-variable "SCSH_TEST1")) +(test-end "setenv") + + +(test-begin "getenv") +(test-equal "foobar" (getenv "SCSH_TEST1")) +(test-end "getenv") + + +(test-begin "glob") +(test-equal '("test.hehe") (glob "*.hehe")) +(test-end "glob") + + + +(test-end "scsh")