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 <spwhitton@spwhitton.name>

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)