scsh: Add tests. Simpilify makefile

.gitignore

@@ -26,3 +26,4 @@ venv
 foreign
 tmp
 *.json
+test-program

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}
+test:
-	rm -rf ${tmpdir}
+	rm -rf test-program
-	mkdir -p ${tmpdir}
+	COMPILE_R7RS=${SCHEME} \
-	cp -r test-resources ${tmpdir}
+	CSC_OPTIONS="${CSC_OPTIONS}" \
-	# R6RS testfiles
+	compile-r7rs -o test-program ${TESTFILE}
-	printf "#!r6rs\n(import (except (rnrs) remove) (srfi :64) (foreign c) (retropikzel ${LIBRARY}))" > ${tmpdir}/test.sps
+	./test-program
-	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: testfiles
+test-docker:
-	cd ${tmpdir} && \
+	DOCKER_TAG=${DOCKER_TAG} \
-		COMPILE_R7RS_DEBUG=1 \
+	COMPILE_R7RS=${SCHEME} \
-		COMPILE_R7RS=${SCHEME} \
+	CSC_OPTIONS="${CSC_OPTIONS}" \
-		CSC_OPTIONS="${CSC_OPTIONS}" \
+	SNOW_PACKAGES="srfi.64 foreign.c ${PKG}" \
-		compile-r7rs ${LIB_PATHS} -o test-program test.${SFX}
+	AKKU_PACKAGES="akku-r7rs chez-srfi '(foreign c)' '(retropikzel ${LIBRARY})'" \
-	cd ${tmpdir} && ./test-program
+	APT_PACKAGES="${APT_PACKAGES}" \
-
+	PASS_ENV_VARS="CSC_OPTIONS" \
-test-docker: testfiles
+		test-r7rs -o test-program ${TESTFILE}
-	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}
 
 clean:
 	git clean -X -f

retropikzel/scsh.scm

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

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
+    getenv
-    ;glob
+    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"))))

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

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)

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