From b16512b1803e65a987967d407285d2af37a159e3 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 28 Nov 2021 14:42:46 -0700 Subject: replace usage of UIOP version comparison utilities with our own DATA.GIT-SNAPSHOT generates version numbers like 2342423.ab09890f2bcd where only the first, purely numerical component is intended for comparison, and the second component is just additional information. UIOP's utilities don't give the correct answers for cases like that; e.g. (uiop:version<= "1.a" "0") => T. Signed-off-by: Sean Whitton --- consfigurator.asd | 1 + src/util.lisp | 40 ++++++++++++++++++++++++++++++++-------- tests/util.lisp | 19 +++++++++++++++++++ 3 files changed, 52 insertions(+), 8 deletions(-) create mode 100644 tests/util.lisp diff --git a/consfigurator.asd b/consfigurator.asd index 41c5a65..b49ecab 100644 --- a/consfigurator.asd +++ b/consfigurator.asd @@ -106,5 +106,6 @@ (:feature :sbcl (:require #:sb-rt)) (:feature (:not :sbcl) #:rt)) :components ((:file "tests/package") + (:file "tests/util") (:file "tests/property/file")) :perform (test-op (o c) (symbol-call :consfigurator/tests '#:do-tests))) diff --git a/src/util.lisp b/src/util.lisp index 704a288..9f0a463 100644 --- a/src/util.lisp +++ b/src/util.lisp @@ -470,20 +470,44 @@ previous output." ;;;; Version numbers -(defun number->string (x) - (etypecase x (string x) (number (format nil "~D" x)))) +(defun compare-versions (x y &optional less-than-or-equal) + (flet + ((components (v) + (etypecase v + (number (list v)) + (string + (loop with buf + = (make-array 0 :fill-pointer 0 :element-type 'character) + for c across v + if (digit-char-p c) + do (vector-push-extend c buf) + else if (and (char= c #\.) (plusp (fill-pointer buf))) + collect (parse-integer buf) into accum + and do (setf (fill-pointer buf) 0) + else do (loop-finish) + finally (return (if (plusp (fill-pointer buf)) + (nconc accum (list (parse-integer buf))) + accum))))))) + (setq x (components x) y (components y)) + (if less-than-or-equal + (loop while (or x y) for a = (or (pop x) 0) and b = (or (pop y) 0) + never (> a b) + if (< a b) return t) + (loop while (or x y) for a = (or (pop x) 0) and b = (or (pop y) 0) + thereis (> b a) + if (< b a) return nil)))) (defun version< (x y) - (uiop:version< (number->string x) (number->string y))) - -(defun version> (x y) - (version< y x)) + (compare-versions x y)) (defun version<= (x y) - (uiop:version<= (number->string x) (number->string y))) + (compare-versions x y t)) + +(defun version> (x y) + (compare-versions y x)) (defun version>= (x y) - (version<= y x)) + (compare-versions y x t)) ;;;; Encoding of strings to filenames diff --git a/tests/util.lisp b/tests/util.lisp new file mode 100644 index 0000000..bffda68 --- /dev/null +++ b/tests/util.lisp @@ -0,0 +1,19 @@ +(in-package :consfigurator/tests) +(named-readtables:in-readtable :consfigurator) +(in-consfig "consfigurator/tests") + +(deftest version<.1 (version< "1.0.1" "1.0.2") t) + +(deftest version<=.1 (version<= "1.0.1" "1.0.2") t) + +(deftest version<.2 (version< "1.0.1" "1.0.1") nil) + +(deftest version<=.2 (version<= "1.0.1" "1.0.1") t) + +(deftest version<.3 (version< "1.1" "1.0.1") nil) + +(deftest version<=.3 (version<= "1.1" "1.0.1") nil) + +(deftest version<.4 (version< "1.a.1" "1.1") t) + +(deftest version<.5 (version< "1..1" "1.1") t) -- cgit v1.2.3