~ chicken-core (chicken-5) 220c71cbf829b43116402ac7807a2220860a2d37

commit 220c71cbf829b43116402ac7807a2220860a2d37
Author:     Peter Bex <peter@more-magic.net>
AuthorDate: Fri Oct 14 21:11:56 2016 +0200
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Fri Oct 28 13:20:30 2016 +1300

    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.
    
    Signed-off-by: Evan Hanson <evhan@foldling.org>

diff --git a/library.scm b/library.scm
index 8d47654e..9d1fc656 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 3f8859ec..bf7e6333 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 f4f257d7..9eaa8f09 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 248a1528..888c71a6 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 e10482eb..745ad1c7 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 851850c8..f26d3d1d 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-<major>.<minor>... ")
@@ -24,4 +23,16 @@
                                   (irregex-match-substring match 2))
                                  minor))))
                 (else (loop (cdr features)))))))
+
+  (display "Checking the registered feature chicken-<major>... ")
+  (let loop ((features (features)))
+    (if (null? features)
+        (error "Could not find feature chicken-<major>")
+        (let ((feature (symbol->string (car features))))
+          (cond ((irregex-match "chicken-(\\d+)" feature)
+                 => (lambda (match)
+                      (assert (= (string->number
+                                  (irregex-match-substring match 1))
+                                 major))))
+                (else (loop (cdr features)))))))
   (print "ok"))