From f8a7458b997ee4f9d84e92063489faecbc8d9d71 Mon Sep 17 00:00:00 2001 From: retropikzel Date: Sat, 27 Jun 2026 14:50:40 +0300 Subject: [PATCH] Improve testing of SRFI-170. Add posix-time --- Jenkinsfile | 44 +++++++++++++++++++++----------------------- Makefile | 11 ++++++++--- srfi/170.scm | 31 +++++++++++-------------------- srfi/170/test.scm | 17 ++++++++++------- 4 files changed, 50 insertions(+), 53 deletions(-) diff --git a/Jenkinsfile b/Jenkinsfile index fc09848..63a46ce 100644 --- a/Jenkinsfile +++ b/Jenkinsfile @@ -12,38 +12,36 @@ pipeline { buildDiscarder(logRotator(numToKeepStr: '10', artifactNumToKeepStr: '10')) } - parameters { - string(name: 'R7RS_SCHEMES', defaultValue: 'chibi chicken gauche guile kawa mosh racket sagittarius stklos ypsilon', description: '') - string(name: 'R6RS_SCHEMES', defaultValue: 'chezscheme guile ikarus ironscheme mosh racket sagittarius ypsilon', description: '') - string(name: 'SRFIS', defaultValue: '106 170', description: '') + environment { + R7RS_SCHEMES="capyscheme chibi chicken gauche kawa mosh racket sagittarius stklos ypsilon" + R6RS_SCHEMES="chezscheme guile ikarus ironscheme mosh racket sagittarius ypsilon" + SRFIS="170" } stages { - stage('Tests') { - stage('R6RS x86_64 Debian') { - steps { - script { - params.SRFIS.split().each { SRFI -> - params.R6RS_SCHEMES.split().each { SCHEME -> - stage("${SCHEME} - ${SRFI}") { - catchError(buildResult: 'SUCCESS', stageResult: 'FAILURE') { - sh "timeout 600 make SCHEME=${SCHEME} SRFI=${SRFI} RNRS=r6rs run-test-docker" - } + stage('x86_64 Debian') { + steps { + script { + env.SRFIS.split().each { SRFI -> + env.R6RS_SCHEMES.split().each { SCHEME -> + stage("${SCHEME} ${SRFI}") { + catchError(buildResult: 'SUCCESS', stageResult: 'FAILURE') { + sh "make SCHEME=${SCHEME} SRFI=${SRFI} RNRS=r6rs run-test-docker" } } } } } } - stage('R7RS x86_64 Debian') { - steps { - script { - params.SRFIS.split().each { SRFI -> - params.R7RS_SCHEMES.split().each { SCHEME -> - stage("${SCHEME} - ${SRFI}") { - catchError(buildResult: 'SUCCESS', stageResult: 'FAILURE') { - sh "timeout 600 make SCHEME=${SCHEME} SRFI=${SRFI} RNRS=r6rs run-test-docker" - } + } + stage('R7RS x86_64 Debian') { + steps { + script { + env.SRFIS.split().each { SRFI -> + env.R7RS_SCHEMES.split().each { SCHEME -> + stage("${SCHEME} ${SRFI}") { + catchError(buildResult: 'SUCCESS', stageResult: 'FAILURE') { + sh "make SCHEME=${SCHEME} SRFI=${SRFI} RNRS=r6rs run-test-docker" } } } diff --git a/Makefile b/Makefile index e380a5b..d41163d 100644 --- a/Makefile +++ b/Makefile @@ -41,9 +41,14 @@ testfiles: mkdir -p .tmp cp ${PKG} .tmp cp -r srfi .tmp/ - cat test-headers.${SFX} ${TESTFILE} | sed 's/SRFI/${SRFI}/' > .tmp/test.${SFX} + cat test-headers.${SFX} ${TESTFILE} \ + | sed 's/SRFI/${SRFI}/' > .tmp/test.${SFX} cat ${TESTFILE} >> run-test.${SFX} - if [ "${RNRS}" = "r6rs" ]; then if [ -d ../foreign-c ]; then cp -r ../foreign-c/foreign .tmp/; fi; fi + if [ "${RNRS}" = "r6rs" ]; \ + then if [ -d ../foreign-c ]; \ + then cp -r ../foreign-c/foreign .tmp/; \ + fi; \ + fi test: testfiles package cd .tmp && COMPILE_R7RS=${SCHEME} compile-r7rs -o test-program test.${SFX} @@ -52,7 +57,7 @@ test: testfiles package test-docker: testfiles package cd .tmp && \ DOCKER_TAG=${DOCKER_TAG} \ - SNOW_PACKAGES="srfi.64 srfi.60 srfi.145 srfi.180 retropikzel.mouth foreign.c ${PKG}" \ + SNOW_PACKAGES="srfi.64 ${PKG}" \ APT_PACKAGES="libcurl4-openssl-dev" \ COMPILE_R7RS=${SCHEME} \ TEST_R7RS_DEBUG=1 \ diff --git a/srfi/170.scm b/srfi/170.scm index 3310276..6ecc0db 100644 --- a/srfi/170.scm +++ b/srfi/170.scm @@ -206,14 +206,14 @@ (define (delete-directory fname) (let* ((fname-pointer (string->c-bytevector fname)) - (result (c-rmdir fname-pointer)) - (error-message "delete-directory error") - (error-pointer (string->c-bytevector error-message))) + (result (c-rmdir fname-pointer))) (c-bytevector-free fname-pointer) (when (< result 0) - (c-perror error-pointer) - (c-bytevector-free error-pointer) - (error error-message)))) + (let* ((error-message "delete-directory error") + (error-pointer (string->c-bytevector error-message))) + (c-perror error-pointer) + (c-bytevector-free error-pointer) + (error error-message))))) (define (set-file-owner fname uid gid) (let ((fname-pointer (string->c-bytevector fname))) @@ -468,17 +468,8 @@ (c-bytevector-free error-pointer) (error error-message))) (else - (let* ((tv-sec (c-bytevector-ref timespec tv_sec-type 0)) - (tv-nsec (c-bytevector-ref timespec - tv_nsec-type - (c-type-size tv_sec-type))) - (time (make-time time-utc tv-sec tv-nsec))) - (display "HERE: tv-sec ") - (write tv-sec) - (newline) - (display "HERE: tv-nsec ") - (write tv-nsec) - (newline) - time - ))) - )) + (make-time time-utc + (c-bytevector-ref timespec + tv_nsec-type + (c-type-size tv_sec-type)) + (c-bytevector-ref timespec tv_sec-type 0)))))) diff --git a/srfi/170/test.scm b/srfi/170/test.scm index 5228fe7..f23b1cb 100644 --- a/srfi/170/test.scm +++ b/srfi/170/test.scm @@ -1,12 +1,12 @@ (test-begin "srfi-170") -;(display (real-path "Makefile")) -;(newline) - -;(exit 0) - (define tmp-dir "/tmp/foreign-c-srfi-170") -(when (file-exists? tmp-dir) (delete-directory tmp-dir)) +(for-each + (lambda (file) + (delete-file (string-append tmp-dir "/" file))) + (directory-files tmp-dir #t)) +(when (file-exists? tmp-dir) + (delete-directory tmp-dir)) (create-directory tmp-dir) (define tmp-file (string-append tmp-dir "/test.txt")) @@ -146,4 +146,7 @@ (write (file-info-directory? tmp-file-info)) (newline) -(test-begin "srfi-170") +(write (posix-time)) +(newline) + +(test-end "srfi-170")