devops/lint: Support @include lines in .texis.

diff --git a/src/devops/lint.scm b/src/devops/lint.scm
index 9c41fe3e0a31ee07a4af1a922a21584f8eaabadf..9b3e00c7b7bfb7f4e3cd2f9c54569595aa04f984 100644 (file)
--- a/src/devops/lint.scm
+++ b/src/devops/lint.scm
@@ -31,96 +31,112 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
   (let* ((name (plugin-name plugin))
         (dir (plugin-directory plugin))
         (file (string dir"/"name".texi")))
-
-    (define (lint)
-      (let* ((texinfo (list->vector (call-with-input-file file read-lines)))
-            (deffns (texinfo-deffns texinfo))
-            (dups (duplicates deffns))
-            (pmodel (read-package-model (string dir"/"name)
-                                        microcode-id/operating-system))
-            (bindings (difference
-                       (append (pmodel/global-exports pmodel)
-                               (if (not pkg)
-                                   '()
-                                   (pmodel/package-bindings pmodel pkg)))
-                       exceptions))
-            (missing (difference bindings deffns))
-            (extras (difference deffns bindings)))
-       (append!
-        (map (lambda (n) (string file": "n" has multiple descriptions")) dups)
-        (map (lambda (n) (string file": "n" is not bound")) extras)
-        (map (lambda (n) (string file": "n" is not documented")) missing))))
-
-    (define deffn-patt
-      (compile-regsexp '(seq "@deffn"(?"x")" "
-                            (alt "Class" "Procedure" "{Generic Procedure}")" "
-                            (group name
-                                   (+ (char-not-in whitespace))))))
-
-    (define (deffn-name line)
-      (let ((match (regsexp-match-string deffn-patt line)))
-       (if match
-           (intern (match-extract match 'name))
-           (error "Could not find binding name:" line))))
-
-    (define (texinfo-deffns lines)
-      (let ((len (vector-length lines)))
-       (let loop ((i 0) (deffns '()))
-         (if (fix:< i len)
-             (let ((line (vector-ref lines i)))
-               (loop (fix:1+ i)
-                     (if (string-prefix? "@deffn" line)
-                         (cons (deffn-name line) deffns)
-                         deffns)))
-             deffns))))
-
-    (define (pmodel/find-package pmodel package-name)
-      (find-matching-item (pmodel/packages pmodel)
-                         (lambda (p) (equal? package-name (package/name p)))))
-
-    (define (pmodel/global-exports pmodel)
-      (define (global-exports package)
-       (append-map! (lambda (link)
-                      (if (eq? '() (package/name
-                                    (binding/package
-                                     (link/destination link))))
-                          (list (binding/name (link/destination link)))
-                          '()))
-                    (package/links package)))
-      (append-map! global-exports (pmodel/packages pmodel)))
-
-    (define (pmodel/package-bindings pmodel package-name)
-      (let ((package (pmodel/find-package pmodel package-name)))
-       (if package
-           (map binding/name (package/bindings package))
-           (error "No such package:" package-name))))
-
-    (define (duplicates listset)
-      (let loop ((items listset) (duplicates '()))
-       (cond ((null? items)
-              (reverse! duplicates))
-             ((memq (car items) (cdr items))
-              (if (memq (car items) duplicates)
-                  (loop (cdr items) duplicates)
-                  (loop (cdr items) (cons (car items) duplicates))))
-             (else
-              (loop (cdr items) duplicates)))))
-
-    (define (difference set1 set2)
-      (let loop ((items set1) (difference '()))
-       (cond ((null? items)
-              difference)
-             ((memq (car items) set2)
-              (loop (cdr items) difference))
-             (else
-              (loop (cdr items) (cons (car items) difference))))))
-
     (if (file-exists? file)
-       (lint)
+       (let* ((texinfo (texi-lines file))
+              (deffns (texinfo-deffns texinfo))
+              (dups (duplicates deffns))
+              (pmodel (read-package-model (string dir"/"name)
+                                          microcode-id/operating-system))
+              (bindings (difference
+                         (append (pmodel/global-exports pmodel)
+                                 (if (not pkg)
+                                     '()
+                                     (pmodel/package-bindings pmodel pkg)))
+                         exceptions))
+              (missing (difference bindings deffns))
+              (extras (difference deffns bindings)))
+         (append!
+          (map (lambda (n) (string file": "n" has multiple descriptions"))dups)
+          (map (lambda (n) (string file": "n" is not bound")) extras)
+          (map (lambda (n) (string file": "n" is not documented")) missing)))
        '())))
 
+(define deffn-patt
+  (compile-regsexp '(seq "@deffn"(?"x")" "
+                        (alt "Class" "Procedure" "{Generic Procedure}")" "
+                        (group name
+                               (+ (char-not-in whitespace))))))
+
+(define (deffn-name line)
+  (let ((match (regsexp-match-string deffn-patt line)))
+    (if match
+       (intern (match-extract match 'name))
+       (error "Could not find binding name:" line))))
+
+(define (texinfo-deffns lines)
+  (let ((len (vector-length lines)))
+    (let loop ((i 0) (deffns '()))
+      (if (fix:< i len)
+         (let ((line (vector-ref lines i)))
+           (loop (fix:1+ i)
+                 (if (string-prefix? "@deffn" line)
+                     (cons (deffn-name line) deffns)
+                     deffns)))
+         deffns))))
+
+(define (pmodel/find-package pmodel package-name)
+  (find-matching-item (pmodel/packages pmodel)
+                     (lambda (p) (equal? package-name (package/name p)))))
+
+(define (pmodel/global-exports pmodel)
+  (define (global-exports package)
+    (append-map! (lambda (link)
+                  (if (eq? '() (package/name
+                                (binding/package
+                                 (link/destination link))))
+                      (list (binding/name (link/destination link)))
+                      '()))
+                (package/links package)))
+  (append-map! global-exports (pmodel/packages pmodel)))
+
+(define (pmodel/package-bindings pmodel package-name)
+  (let ((package (pmodel/find-package pmodel package-name)))
+    (if package
+       (map binding/name (package/bindings package))
+       (error "No such package:" package-name))))
+
+(define (duplicates listset)
+  (let loop ((items listset) (duplicates '()))
+    (cond ((null? items)
+          (reverse! duplicates))
+         ((memq (car items) (cdr items))
+          (if (memq (car items) duplicates)
+              (loop (cdr items) duplicates)
+              (loop (cdr items) (cons (car items) duplicates))))
+         (else
+          (loop (cdr items) duplicates)))))
+
+(define (difference set1 set2)
+  (let loop ((items set1) (difference '()))
+    (cond ((null? items)
+          difference)
+         ((memq (car items) set2)
+          (loop (cdr items) difference))
+         (else
+          (loop (cdr items) (cons (car items) difference))))))
+
+(define (texi-lines file)
+  (list->vector (reverse! (texi-lines-reversed file))))
+
+(define (texi-lines-reversed file)
+  (call-with-input-file file
+    (lambda (port)
+      (let loop ((lines '()))
+       (let ((line (read-line port)))
+         (cond ((eof-object? line)
+                lines)
+               ((string-prefix? "@include " line)
+                (let ((name (string-trim (substring line 9))))
+                  (if (not (string=? name "version.texi"))
+                      (loop (append! (texi-lines-reversed
+                                      (merge-pathnames name file))
+                                     lines))
+                      (loop (cons line lines)))))
+               (else
+                (loop (cons line lines)))))))))
+
 (define (plugin-texi-SCMVERS-lint file-name file-lines core-version-string)
-  ;; Too specific for general use.
+  ;; Needs the version number in the build-depends of debian/control!
   (let ((line (find file-lines
                    (lambda (line)
                      (string-prefix? "@set SCMVERS " line)))))