devops: Check plugin version numbers in NEWS and make.scm files.

diff --git a/src/devops/devops.scm b/src/devops/devops.scm
index 207eae998364ffeadefc56c48239a259475831c9..7ac58bc77976641fca81036fffd9f9aae4b57847 100644 (file)
--- a/src/devops/devops.scm
+++ b/src/devops/devops.scm
@@ -86,6 +86,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
      (changes-lint changes)
      (dirt-lint pdirt)
      (debian-version-lint version (debian-version dir))
+     (news-version-lint plugin version)
+     (subsystem-version-lint plugin version)
      (released-version-lint version (released-version pkg) changes)
      (if plugin-lint-hook
         (plugin-lint-hook plugin version changes dirt)
@@ -121,6 +123,26 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
                     " does not match."))
        '())))
 
+(define (news-version-lint plugin version)
+  (let ((nvers (read-news-version plugin version)))
+    (append
+     (if (not nvers)
+        (list "NEWS version not found.")
+        '())
+     (if (and nvers (not (string=? nvers (version-string version))))
+        (list (string "NEWS version ("nvers") does not match."))
+        '()))))
+
+(define (subsystem-version-lint plugin version)
+  (let ((svers (read-subsystem-version plugin version)))
+    (append
+     (if (not svers)
+        (list "Subsystem version not found.")
+        '())
+     (if (and svers (not (version=? svers version)))
+        (list (string "Subsystem version "svers" does not match."))
+        '()))))
+
 (define (released-version-lint version released changes)
   (cond ((eq? #f released)
         (list "First release!"))
@@ -179,6 +201,72 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
                  (error "could not find core version")
                  (loop))))))))
 
+(define (make-news-pattern fullname)
+  (compile-regsexp `(seq ,fullname
+                        #\space
+                        (group version
+                               (+ (alt #\. (char-in numeric))))
+                        " - "
+                        (group author (+ (char-not-in #\,)))
+                        ", "
+                        (group year (+ (char-in numeric)))
+                        "-"
+                        (group month (+ (char-in numeric)))
+                        "-"
+                        (group day (+ (char-in numeric)))
+                        (string-end))))
+
+(define (read-news-version plugin version)
+  (let* ((fullname (string (project-name)"-"(plugin-name plugin)))
+        (file (string (plugin-directory plugin)"/NEWS")))
+    (and (file-exists? file)
+        (let ((pattern (make-news-pattern fullname)))
+          (call-with-input-file file
+            (lambda (in)
+              (let loop ()
+                (let ((line (read-line in)))
+                  (if (eof-object? line)
+                      #f
+                      (let ((match (regsexp-match-string pattern line)))
+                        (if match
+                            (match-extract match 'version)
+                            (loop))))))))))))
+
+(define (make-subsystem-pattern plugin)
+  (compile-regsexp
+   '(seq "(add-subsystem-identification!"
+        " \""(+ (char-not-in #\"))"\""
+        " '"(group version (seq "("
+                                (+ (alt #\space (char-in numeric)))
+                                ")"))
+        ")")))
+
+(define (read-subsystem-version plugin version)
+  (let* ((fullname (string (project-name)"-"(plugin-name plugin)))
+        (file (find-plugin-make.scm plugin)))
+    (and file
+        (let ((pattern (make-subsystem-pattern plugin)))
+          (call-with-input-file file
+            (lambda (in)
+              (let loop ()
+                (let ((line (read-line in)))
+                  (if (eof-object? line)
+                      #f
+                      (let ((match (regsexp-match-string pattern line)))
+                        (if match
+                            (call-with-input-string
+                                (match-extract match 'version)
+                              read)
+                            (loop))))))))))))
+
+(define (find-plugin-make.scm plugin)
+  (or (let ((file (string (plugin-directory plugin)"/make.scm")))
+       (and (file-exists? file)
+            file))
+      (let ((file (string (plugin-directory plugin)"/mit-make.scm")))
+       (and (file-exists? file)
+            file))))
+
 (define (released-version name)
   (let ((tags (sorted-tags name)))
     (and (pair? tags)