From 21d22fa63507501582e4eb95fe57bc3e31e166bb Mon Sep 17 00:00:00 2001 From: Peter Bex
Date: Fri, 14 Oct 2016 21:11:56 +0200 Subject: [PATCH 7/9] Replace CHICKEN version fudges with foreign-values This requires the version test to be compiled. The test is still useful, as it compares the version in build-version.scm with the baked in constant definitions of C_{MAJOR,MINOR}_VERSION. --- library.scm | 11 +++++------ runtime.c | 4 ++-- setup-download.scm | 3 ++- tests/runtests.bat | 4 +++- tests/runtests.sh | 3 ++- tests/version-tests.scm | 17 ++++++++++++++--- 6 files changed, 28 insertions(+), 14 deletions(-) diff --git a/library.scm b/library.scm index 90cbf15..7b1bc7e 100644 --- a/library.scm +++ b/library.scm @@ -4481,12 +4481,11 @@ EOF (set! ##sys#features (cons #:64bit ##sys#features))) (set! ##sys#features - (let ((major (##sys#string-append "chicken-" (##sys#number->string (##sys#fudge 41))))) - (cons (##sys#->feature-id major) - (cons (##sys#->feature-id - (string-append - major "." - (##sys#number->string (##sys#fudge 43)))) + (let ((major (##sys#number->string (foreign-value "C_MAJOR_VERSION" int))) + (minor (##sys#number->string (foreign-value "C_MINOR_VERSION" int)))) + (cons (##sys#->feature-id (string-append "chicken-" major)) + (cons (##sys#->feature-id + (string-append "chicken-" major "." minor)) ##sys#features)))) (define (register-feature! . fs) diff --git a/runtime.c b/runtime.c index 3f8859e..bf7e633 100644 --- a/runtime.c +++ b/runtime.c @@ -4957,13 +4957,13 @@ C_regparm C_word C_fcall C_fudge(C_word fudge_factor) panic(C_text("(##sys#fudge 40) [manyargs] is obsolete")); case C_fix(41): /* major CHICKEN version */ - return C_fix(C_MAJOR_VERSION); + panic(C_text("(##sys#fudge 41) [major version] is obsolete")); case C_fix(42): /* binary version number */ panic(C_text("(##sys#fudge 42) [binary version] is obsolete")); case C_fix(43): /* minor CHICKEN version */ - return C_fix(C_MINOR_VERSION); + panic(C_text("(##sys#fudge 43) [minor version] is obsolete")); case C_fix(44): /* whether debugger is active */ panic(C_text("(##sys#fudge 44) [debugging] is obsolete")); diff --git a/setup-download.scm b/setup-download.scm index f4f257d..9eaa8f0 100644 --- a/setup-download.scm +++ b/setup-download.scm @@ -60,6 +60,7 @@ (define *trunk* #f) (define *mode* 'default) (define *windows-shell* (foreign-value "C_WINDOWS_SHELL" bool)) + (define *chicken-release* (foreign-value "C_MAJOR_VERSION" int)) (define (d fstr . args) (let ([port (if *quiet* (current-error-port) (current-output-port))]) @@ -186,7 +187,7 @@ (let* ((locn (string-append locn "?name=" egg - "&release=" (->string (##sys#fudge 41)) + "&release=" (->string *chicken-release*) (if version (string-append "&version=" version) "") "&mode=" (->string *mode*) (if tests "&tests=yes" ""))) diff --git a/tests/runtests.bat b/tests/runtests.bat index 248a152..888c71a 100644 --- a/tests/runtests.bat +++ b/tests/runtests.bat @@ -27,7 +27,9 @@ mkdir test-repository copy %TYPESDB% test-repository echo ======================================== version tests ... -%interpret% -s version-tests.scm +%compile% version-tests.scm +if errorlevel 1 exit /b 1 +a.out if errorlevel 1 exit /b 1 echo ======================================== compiler tests ... diff --git a/tests/runtests.sh b/tests/runtests.sh index e10482e..745ad1c 100755 --- a/tests/runtests.sh +++ b/tests/runtests.sh @@ -95,7 +95,8 @@ interpret="../csi -n -include-path ${TEST_DIR}/.." rm -f *.exe *.so *.o *.import.* a.out ../foo.import.* echo "======================================== version tests ..." -$interpret -s version-tests.scm +$compile version-tests.scm +./a.out echo "======================================== compiler tests ..." $compile compiler-tests.scm diff --git a/tests/version-tests.scm b/tests/version-tests.scm index 851850c..f26d3d1 100644 --- a/tests/version-tests.scm +++ b/tests/version-tests.scm @@ -5,9 +5,8 @@ (minor (string->number (cadr version-tokens)))) (display "Checking major and minor version numbers against chicken-version... ") - ;; Those fudges are mapped to C_MAJOR_VERSION and C_MINOR_VERSION - (assert (= (##sys#fudge 41) major)) - (assert (= (##sys#fudge 43) minor)) + (assert (= (foreign-value "C_MAJOR_VERSION" int) major)) + (assert (= (foreign-value "C_MINOR_VERSION" int) minor)) (print "ok") (display "Checking the registered feature chicken-