devops: Fix version>? and move it out of build.scm.

diff --git a/src/devops/build.scm b/src/devops/build.scm
index 180458a3a722d7ec4d3f59c9c327a003c96c405e..2403d61a3b80fa59cecf1b43e3664b685fe85f00 100644 (file)
--- a/src/devops/build.scm
+++ b/src/devops/build.scm
@@ -202,14 +202,6 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 (define (read-debian-architecture)
   (car (shell-lines "dpkg-architecture -qDEB_TARGET_ARCH")))
 
-(define (read-host-arch.version exe)
-  (let ((expr (string "(write-line"
-                     " (cons microcode-id/compiled-code-type"
-                     "       (get-subsystem-version \"Release\")))")))
-    (read (open-input-string
-          (car (shell-lines exe " --batch-mode"
-                            " --eval '"expr"' --eval '(%exit)'"))))))
-
 (load-option 'regular-expression)
 
 (define (available-sources dir)
@@ -228,39 +220,6 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
         (directory-file-names dir #f))
        (lambda (a b) (< (car a) (car b))))))
 
-(define (version-comparator < >)
-  (named-lambda (version-compare v1 v2)
-    (let loop ((v1 v1) (v2 v2))
-      (cond ((eq? #f v1)
-            #t)
-           ((eq? #f v2)
-            #f)
-           ((null? v2)
-            #f)
-           ((null? v1) ;; and (pair? v2)
-            #t)
-           ((< (car v1) (car v2))
-            #t)
-           ((> (car v1) (car v2))
-            #f)
-           (else
-            (loop (cdr v1) (cdr v2)))))))
-
-(define (->version string)
-  (and string
-       (map string->number (burst-string string #\. #f))))
-
-(define (version-string version)
-  (if (pair? version)
-      (decorated-string-append "" "." ""
-       (map (lambda (num) (number->string num 10))
-           version))
-      (error "Bad version:" version)))
-
-(define version=? equal?)
-(define version<? (version-comparator < >))
-(define version>? (version-comparator > <))
-
 (define (in-batch thunk)
   (fresh-line)
   (write-string "OK\n")

diff --git a/src/devops/devops.scm b/src/devops/devops.scm
index 68e26b3a1b4c72199bcbec687386b20dc3916187..8d97afbfb17e87374f4b5bc8bc0d8944f8d88ce4 100644 (file)
--- a/src/devops/devops.scm
+++ b/src/devops/devops.scm
@@ -871,6 +871,14 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
          (if (not (zero? plugin-errors))
              (error "Plugins failed to build:" plugin-errors))))))
 
+(define (read-host-arch.version exe)
+  (let ((expr (string "(write-line"
+                     " (cons microcode-id/compiled-code-type"
+                     "       (get-subsystem-version \"Release\")))")))
+    (read (open-input-string
+          (car (shell-lines exe " --batch-mode"
+                            " --eval '"expr"' --eval '(%exit)'"))))))
+
 (define (load-make-config)
   (cond ((file-exists? "devops-config.scm")
         (load "devops-config.scm" '(devops)))
@@ -928,11 +936,11 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
 (define (make-install-doc prefix)
   (if (not (file-exists? "doc/configure"))
-      (trun "cd doc/; autoconf"))
+      (trun "cd doc/ && autoconf"))
   (if (not (file-exists? "doc/Makefile"))
-      (trun "cd doc/; ./configure --prefix="prefix))
-  (trun "cd doc/; make all")
-  (trun "cd doc/; umask 022; make install"))
+      (trun "cd doc/ && ./configure --prefix="prefix))
+  (trun "cd doc/ && make all")
+  (trun "cd doc/ && umask 022 && make install"))
 
 (define default-plugin-names '("edwin" "imail" "x11" "x11-screen"))
 
@@ -957,18 +965,18 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
        (error "Plugin directory not found:" dir))
     (log "# "dir":\n")
     (if (not (file-exists? (string dir"/configure")))
-       (trun "cd "dir"/; ./autogen.sh"))
+       (trun "cd "dir"/ && ./autogen.sh"))
     (if (not (file-exists? (string dir"/Makefile")))
-       (trun "cd "dir"/; ./configure --prefix="prefix))
-    (trun "cd "dir"/; make tags")
-    (trun "cd "dir"/; make all")
-    (trun "cd "dir"/; make check")
-    (trun "cd "dir"/; umask 022; make install")
+       (trun "cd "dir"/ && ./configure --prefix="prefix))
+    (trun "cd "dir"/ && make tags")
+    (trun "cd "dir"/ && make all")
+    (trun "cd "dir"/ && make check")
+    (trun "cd "dir"/ && umask 022 && make install")
     (if (find (lambda (line) (string-prefix? "info_TEXINFOS" line))
              (file-lines dir"/Makefile.am"))
        (begin
-         (trun "cd "dir"/; umask 022; make install-html")
-         (trun "cd "dir"/; umask 022; make install-pdf")))))
+         (trun "cd "dir"/ && umask 022 && make install-html")
+         (trun "cd "dir"/ && umask 022 && make install-pdf")))))
 
 (define (trun . strings)
   ;;(log-timestamp)
@@ -1131,6 +1139,35 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
           (shell-lines "git tag -l '"package-name"-*'")))
        (lambda (a b) (version>? (car a) (car b)))))
 
+(define (->version string)
+  (and string
+       (map string->number (burst-string string #\. #f))))
+
+(define (version-string version)
+  (if (pair? version)
+      (decorated-string-append "" "." ""
+       (map (lambda (num) (number->string num 10))
+           version))
+      (error "Bad version:" version)))
+
+(define version=? equal?)
+
+(define (version<? v1 v2)
+  (let loop ((v1 v1) (v2 v2))
+    (cond ((null? v2)
+          #f)
+         ((null? v1)
+          #t)
+         ((< (car v1) (car v2))
+          #t)
+         ((> (car v1) (car v2))
+          #f)
+         (else
+          (loop (cdr v1) (cdr v2))))))
+
+(define (version>? v1 v2)
+  (version<? v2 v1))
+
 (define (match-extract match key)
   (let ((entry (assq key (cddr match))))
     (if entry