Hi! Please find attached a slightly revised patch for the mentioned functionality. I made the following changes:
- I moved the "version>=?" procedure into extra.scm, to make this all a bit more lightweight, we don't really need another library unit for this. - I removed "version<?", it can be trivially derived by the user, if required. - I added "/" as a separator character and changed the implementation to use numeric comparison if the initial arguments are numeric or are convertible to numbers. cheers, felix
From b0c6655538c675ed25b5ce524169ea471835bc9a Mon Sep 17 00:00:00 2001 From: felix <[email protected]> Date: Wed, 29 Oct 2025 19:49:46 +0100 Subject: [PATCH] add (chicken version) module This is a modified version of a patch from Mario Goulart, with version>=? added to extras instead of providing a separate library unit. Version=?> has also been changed to compare numeric arguments directly instead of converting to strings. Version<? has been removed. --- .gitignore | 1 + NEWS | 1 + README | 1 + chicken-install.scm | 20 +-------------- defaults.make | 2 +- distribution/manifest | 4 +++ eval-modules.scm | 1 + extras.scm | 47 ++++++++++++++++++++++++++++++++++ manual/Included modules | 1 + manual/Module (chicken type) | 2 +- manual/Module srfi-4 | 2 +- rules.make | 5 +++- tests/runtests.sh | 3 +++ tests/version-module-tests.scm | 32 +++++++++++++++++++++++ types.db | 3 +++ 15 files changed, 102 insertions(+), 23 deletions(-) create mode 100644 tests/version-module-tests.scm diff --git a/.gitignore b/.gitignore index 202db4f9..aa42fbe0 100644 --- a/.gitignore +++ b/.gitignore @@ -95,6 +95,7 @@ /chicken.eval.import.scm /chicken.file.import.scm /chicken.file.posix.import.scm +/chicken.version.import.scm /chicken.fixnum.import.scm /chicken.flonum.import.scm /chicken.format.import.scm diff --git a/NEWS b/NEWS index 7138508f..f3822211 100644 --- a/NEWS +++ b/NEWS @@ -81,6 +81,7 @@ separation. - Added `expand1' to (chicken syntax) module for expanding a macro only once, also added the ",x1" command to "csi" for this. + - Added the (chicken version) module. - Syntax expander: - `syntax-rules' attempts to better support tail patterns with ellipses diff --git a/README b/README index 7b80992c..4d8ac78e 100644 --- a/README +++ b/README @@ -342,6 +342,7 @@ _/ _/ _/ _/ _/ _/ _/ _/ _/ _/_/ | | |-- chicken.tcp.import.so | | |-- chicken.time.import.so | | |-- chicken.time.posix.import.so + | | |-- chicken.version.import.so | | |-- scheme.file.import.so | | |-- scheme.process-context.import.so | | |-- scheme.time.import.so diff --git a/chicken-install.scm b/chicken-install.scm index 32a5bf9f..782604b6 100644 --- a/chicken-install.scm +++ b/chicken-install.scm @@ -53,6 +53,7 @@ (import (chicken process-context posix)) (import (chicken pretty-print)) (import (chicken string)) +(import (chicken version)) (import (chicken bytevector)) (import (only (scheme base) open-input-string)) @@ -267,25 +268,6 @@ (apply fprintf port fstr args) (flush-output port) ) ))) -(define (version>=? v1 v2) - (define (version->list v) - (map (lambda (x) (or (string->number x) x)) - (irregex-split "[-\\._]" (->string v)))) - (let loop ((p1 (version->list v1)) - (p2 (version->list v2))) - (cond ((null? p1) (null? p2)) - ((null? p2)) - ((number? (car p1)) - (and (number? (car p2)) - (or (> (car p1) (car p2)) - (and (= (car p1) (car p2)) - (loop (cdr p1) (cdr p2)))))) - ((number? (car p2))) - ((string>? (car p1) (car p2))) - (else - (and (string=? (car p1) (car p2)) - (loop (cdr p1) (cdr p2))))))) - ;; load defaults file ("setup.defaults") diff --git a/defaults.make b/defaults.make index 5ff724ce..e9747860 100644 --- a/defaults.make +++ b/defaults.make @@ -270,7 +270,7 @@ PRIMITIVE_IMPORT_LIBRARIES = chicken.base chicken.condition \ DYNAMIC_IMPORT_LIBRARIES = srfi-4 DYNAMIC_CHICKEN_IMPORT_LIBRARIES = bitwise bytevector errno file.posix \ fixnum flonum format gc io keyword load locative memory \ - memory.representation platform plist pretty-print \ + memory.representation platform plist pretty-print version \ process process.signal process-context process-context.posix \ random sort string time.posix number-vector DYNAMIC_CHICKEN_COMPILER_IMPORT_LIBRARIES = user-pass diff --git a/distribution/manifest b/distribution/manifest index d19d2fdd..dc5b7b2b 100644 --- a/distribution/manifest +++ b/distribution/manifest @@ -251,6 +251,7 @@ tests/reverser/tags/1.1/reverser.egg tests/reverser/tags/1.1/reverser.scm tests/user-pass-tests.scm tests/version-tests.scm +tests/version-module-tests.scm tests/messages-test.scm tests/messages.expected tests/types-db-consistency.scm @@ -379,6 +380,8 @@ chicken.time.import.scm chicken.time.import.c chicken.time.posix.import.scm chicken.time.posix.import.c +chicken.version.import.scm +chicken.version.import.c srfi-4.import.scm srfi-4.import.c scheme.file.import.scm @@ -476,6 +479,7 @@ manual-html/Module (chicken tcp).html manual-html/Module (chicken time).html manual-html/Module (chicken time posix).html manual-html/Module (chicken type).html +manual-html/Module (chicken version).html manual-html/Module scheme.html manual-html/Module (scheme base).html manual-html/Module (scheme case-lambda).html diff --git a/eval-modules.scm b/eval-modules.scm index 5c4ed095..fdae737a 100644 --- a/eval-modules.scm +++ b/eval-modules.scm @@ -92,6 +92,7 @@ (defmod chicken.read-syntax) (defmod chicken.repl) (defmod chicken.tcp) +(defmod chicken.version) (defmod chicken.number-vector) (defmod srfi-4) (defmod scheme.write) diff --git a/extras.scm b/extras.scm index 921706b4..a0c8f0ef 100644 --- a/extras.scm +++ b/extras.scm @@ -480,3 +480,50 @@ dest)))) ) + + +;;; Version comparison (used for egg versions) + +(module chicken.version (version>=?) + +(import scheme) +(import (chicken base) + (chicken string) + (chicken fixnum)) + +(define (version>=? v1 v2) + (define (version->list v) + (map (lambda (x) (or (string->number x) x)) + (let* ((s (->string v)) + (len (string-length s))) + (let loop ((start 0) (pos 0)) + (cond ((fx>= pos len) (list (substring s start len))) + ((memv (string-ref s pos) '(#\- #\\ #\. #\_ #\/)) + (cons (substring s start pos) + (let ((p2 (fx+ pos 1))) + (loop p2 p2)))) + (else (loop start (fx+ pos 1)))))))) + (define (numval v) + (if (number? v) + v + (string->number v))) + (let ((n1 (numval v1)) + (n2 (numval v2))) + (if (and n1 n2) + (>= n1 n2) + (let loop ((p1 (version->list v1)) + (p2 (version->list v2))) + (cond ((null? p1) (null? p2)) + ((null? p2)) + ((number? (car p1)) + (and (number? (car p2)) + (or (> (car p1) (car p2)) + (and (= (car p1) (car p2)) + (loop (cdr p1) (cdr p2)))))) + ((number? (car p2))) + ((string>? (car p1) (car p2))) + (else + (and (string=? (car p1) (car p2)) + (loop (cdr p1) (cdr p2))))))))) + +) ;; end module diff --git a/manual/Included modules b/manual/Included modules index b2390d46..db2cffa4 100644 --- a/manual/Included modules +++ b/manual/Included modules @@ -74,6 +74,7 @@ default all exports of the [[Module scheme|scheme]], * [[Module (chicken time)]] : Fetching information about the current time * [[Module (chicken time posix)]] : Manipulating POSIX time * [[Module (chicken type)]] : Defining and using static typing information +* [[Module (chicken version)]] : Version comparison operations * [[Module srfi-4]] : The subset of [[Module (chicken number-vector)]] specified by SRFI-4 In addition to the core modules listed above, the following SRFI modules can be diff --git a/manual/Module (chicken type) b/manual/Module (chicken type) index 9673dde7..d585cd53 100644 --- a/manual/Module (chicken type) +++ b/manual/Module (chicken type) @@ -9,4 +9,4 @@ The functionality in this module is available by default. See --- Previous: [[Module (chicken time posix)]] -Next: [[Module srfi-4]] +Next: [[Module (chicken version)]] diff --git a/manual/Module srfi-4 b/manual/Module srfi-4 index dcd18afb..6493af03 100644 --- a/manual/Module srfi-4 +++ b/manual/Module srfi-4 @@ -93,7 +93,7 @@ The module exports the following identifiers: <procedure>(list->f64vector F64LIST)</procedure><br> --- -Previous: [[Module (chicken type)]] +Previous: [[Module (chicken version)]] Next: [[Interface to external functions and variables]] diff --git a/rules.make b/rules.make index 659560c1..69d3bc07 100644 --- a/rules.make +++ b/rules.make @@ -479,6 +479,7 @@ $(eval $(call declare-emitted-import-lib-dependency,chicken.load,eval)) $(eval $(call declare-emitted-import-lib-dependency,chicken.format,extras)) $(eval $(call declare-emitted-import-lib-dependency,chicken.io,library)) $(eval $(call declare-emitted-import-lib-dependency,chicken.pretty-print,extras)) +$(eval $(call declare-emitted-import-lib-dependency,chicken.version,extras)) $(eval $(call declare-emitted-import-lib-dependency,chicken.random,extras)) $(eval $(call declare-emitted-import-lib-dependency,chicken.locative,lolevel)) $(eval $(call declare-emitted-import-lib-dependency,chicken.memory,lolevel)) @@ -681,6 +682,7 @@ chicken-install.c: chicken-install.scm \ chicken.process-context.import.scm \ chicken.sort.import.scm \ chicken.string.import.scm \ + chicken.version.import.scm \ chicken.tcp.import.scm chicken-uninstall.c: chicken-uninstall.scm \ chicken.file.import.scm \ @@ -843,7 +845,8 @@ extras.c: $(SRCDIR)extras.scm $(SRCDIR)common-declarations.scm $(bootstrap-lib) \ -emit-import-library chicken.format \ -emit-import-library chicken.pretty-print \ - -emit-import-library chicken.random + -emit-import-library chicken.random \ + -emit-import-library chicken.version posixunix.c: $(SRCDIR)posix.scm $(SRCDIR)posixunix.scm $(SRCDIR)posix-common.scm $(SRCDIR)common-declarations.scm $(bootstrap-lib) -feature platform-unix \ -emit-import-library chicken.errno \ diff --git a/tests/runtests.sh b/tests/runtests.sh index c3ad34a7..7753ae1f 100755 --- a/tests/runtests.sh +++ b/tests/runtests.sh @@ -554,4 +554,7 @@ $interpret -s multiple-values.scm $compile multiple-values.scm ./a.out +echo "======================================== version module tests ..." +$interpret -bnq version-module-tests.scm + echo "======================================== done. All tests passed." diff --git a/tests/version-module-tests.scm b/tests/version-module-tests.scm new file mode 100644 index 00000000..146c367c --- /dev/null +++ b/tests/version-module-tests.scm @@ -0,0 +1,32 @@ +(import (chicken eval) + (chicken load) + (chicken version)) + +(cond-expand + (compiling + (include "test.scm") ) + (else + (load-relative "test.scm"))) + +(test-begin "chicken.version") + +(test-assert "0 >= 0" (version>=? "0" "0")) +(test-assert "1 >= 0" (version>=? "1" "0")) +(test-assert "1.0 >= 0.0.1" (version>=? "1.0" "0.0.1")) +(test-assert "1.0 >= 0.1.1" (version>=? "1.0" "0.1.1")) +(test-assert "0.0.0 >= 0.0.0" (version>=? "0.0.0" "0.0.0")) +(test-assert "0.0.0 >= 0.0" (version>=? "0.0.0" "0.0")) +(test-assert "0.0.1 >= 0.0.0" (version>=? "0.0.1" "0.0.0")) +(test-assert "1.0.0 >= 0.0.0" (version>=? "1.0.0" "0.0.0")) +(test-assert "1.0.0 >= 0.0.0b" (version>=? "1.0.0" "0.0.0b")) +(test-assert "1.0.0b >= 1.0.0" (version>=? "1.0.0b" "1.0.0")) +(test-assert "1.0.0 >= 0.9.9-rc1" (version>=? "1.0.0" "0.9.9-rc1")) +(test-assert "1.10 >= 1.09" (version>=? "1.10" "1.09")) +(test-assert "1.10.2 >= 1.09.2" (version>=? "1.10.2" "1.09.2")) +(test-assert "(numbers) 0 >= 0" (version>=? 0 0)) +(test-assert "(numbers) 1 >= 0" (version>=? 1 0)) +(test-assert "(numbers) 1.10 >= 1.09" (version>=? 1.10 1.09)) + +(test-end "chicken.version") + +(test-exit) diff --git a/types.db b/types.db index a791fbcb..51fb5fd1 100644 --- a/types.db +++ b/types.db @@ -2462,6 +2462,9 @@ (chicken.tcp#tcp-read-timeout (#(procedure #:clean #:enforce) chicken.tcp#tcp-read-timeout (#!optional (or false integer)) (or false integer))) (chicken.tcp#tcp-write-timeout (#(procedure #:clean #:enforce) chicken.tcp#tcp-write-timeout (#!optional (or false integer)) (or false integer))) +;; version +(chicken.version#version>=? (#(procedure #:pure #:foldable) chicken.version#version>=? (* *) boolean)) + ;; Undocumented internal module, only here to have the deprecation warning because some eggs use it (chicken.compiler.support#read/source-info deprecated) -- 2.44.1
