~ chicken-core (chicken-5) /scripts/compare-documentation-exports.scm

 1;; This script takes a filename as its first argument, which should be a file
 2;; consisting of multiple lists in this format: ((module name) exported-symbol ...)
 3;; It imports the specified module and checks that the export list of the module matches
 4;; with the one supplied in the file.
 5;; This is useful to check that the documentation and module exports are synchronized.
 6
 7;; TODO make the script read svn-wiki syntax directly
 8
 9(import chicken.sort srfi-1)
10
11(define *exit-code* 0)
12
13(define (warn msg . args)
14  (apply fprintf (current-error-port)
15         msg args)
16  (set! *exit-code* 1))
17
18(define (module-exports mod)
19  (receive (_ ve se) (##sys#module-exports mod)
20    (sort (append (map car ve) (map car se)) symbol<?)))
21
22(define (symbol<? s1 s2)
23  (string<? (symbol->string s1)
24            (symbol->string s2)))
25
26(define (check-module name exports)
27  (eval `(import ,name))
28  (let* ((exports (sort exports symbol<?))
29         (canonical-name
30          (string->symbol
31            (string-intersperse (map ->string name) ".")))
32         (mod (##sys#find-module canonical-name))
33         (mod-exports (module-exports mod))
34         (diff (lset-difference eqv? exports mod-exports)))
35    (unless (null? diff)
36      (warn "Mismatch is ~a: ~a~%"
37            name diff))))
38
39(define (run-checks filename)
40  (with-input-from-file filename
41    (lambda ()
42      (port-for-each check read))))
43
44(define (check desc)
45  (check-module (car desc) (cdr desc)))
46
47(run-checks (car (command-line-arguments)))
48
49(exit *exit-code*)