racket/collects/tests/utils/docs-complete.rkt

81 lines
2.5 KiB
Racket

#lang racket/base
(require setup/xref
scribble/xref
racket/pretty
racket/list
racket/contract/base)
;; checks to make sure that all of the exports of
;; the 'what' library are documented
(provide/contract [check-docs (-> symbol? any)])
(define (check-docs what)
(define pieces (regexp-split #rx"/" (symbol->string what)))
(cond
[(null? pieces) (error 'get-docs "bad arg ~s" what)]
[(null? (cdr pieces))
(set! pieces (list (car pieces) "main"))]
[else (void)])
(define lib0 (list-ref pieces 0))
(define file (last pieces))
(define lib1-n (reverse (cdr (reverse (cdr pieces)))))
(define (pick-one . args)
(for/or ([fmt (in-list args)])
(define pth
(apply build-path
(append (list (collection-path lib0))
lib1-n
(list "compiled"
(format fmt file)))))
(and (file-exists? pth)
pth)))
(define-values (val-info stx-info)
(let/ec k
(module-compiled-exports
(parameterize ([read-accept-compiled #t])
(define file (pick-one "~a_rkt.zo"
"~a_ss.zo"
"~a_scm.zo"))
(if file
(call-with-input-file file read)
(k '() '()))))))
(define (get n info)
(define a (assoc n info))
(if a (cdr a) '()))
(define exports
(map car
(append (get 0 val-info)
(get 0 stx-info))))
(define undocumented-exports
(for/list ([ex (in-list exports)]
#:when
(not (xref-binding->definition-tag
xref
(list what ex)
#f))
#:when
(not (regexp-match #rx"^deserialize-info:" (symbol->string ex))))
ex))
(unless (null? undocumented-exports)
;; show the undocumented exports from the racket/contract library
(eprintf "~s has undocumented exports:\n" what)
(parameterize ([pretty-print-print-line
(λ (line-num port old-len dest-cols)
(cond
[(not line-num)
(newline port)
0]
[(equal? line-num 0)
(fprintf port " ")
2]
[else
(fprintf port "\n ")
2]))])
(pretty-write undocumented-exports (current-error-port)))))
(define xref (load-collections-xref))