diff options
| -rw-r--r-- | consfigurator.asd | 1 | ||||
| -rw-r--r-- | src/util.lisp | 40 | ||||
| -rw-r--r-- | tests/util.lisp | 19 |
3 files changed, 52 insertions, 8 deletions
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) |